Inhalt von Blättern nacheiander in neuer Mappe

Forumthread: Inhalt von Blättern nacheiander in neuer Mappe

Blättern

Hallo VBA-Spezialisten,
habe Arbeitsmappen verschiedener User in verschiedenen Ordnern, diese Arbeitsmappen beinhalten immer das Arbeitsblatt "Protokoll" im Gleichem Format.
Mein Ziel ist es die Inhalte der Protokoll-Arbeitsblätter in einem Arbeitsblatt einer neuen Arbeitsmappe gesammelt (alle Protokolle nacheinander gelistet) zusammenzufassen um z.B. alle protokoll Inhalte gesammelt filtern zu können.
Mein Problem: VBA zu schwach um selbst dies zu programmieren zu können, und das googeln hat seit 2 Tagen noch nichts funktionierendes gebracht....
Vielversprechend war.. siehe Anlage
Aber es kommt immer Fehler bei "GetEndLine"...
Kann bitte jemand helfen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Inhalt von Blättern nacheiander in neuer Mappe

15.07.2011 13:23:24

Blättern

Hier der verwendete aber nicht funktionierende Code:
Option Explicit
Const HomeDatei = "C:\Makro.xls" 'Name Arbeitsmappe Makro-Excel-Datei
Const HomeDaten = "Protokoll" 'Name Tabellenblatt Daten-Import
Const HomeListe = "Protokoll" 'Name Tabellenblatt Datei-Liste
Const HomeZeile = 3 'Erste Zeile Einfügen
Const CopyZeile = 3 'Erste Zeile Kopieren
Const ListDatei = "A1" 'Zelle erster Dateiname
Const ErrMsg = "Abbruch! Datei existiert nicht: "

Sub SheetsImport()
Dim WksHome As Worksheet, WksList As Worksheet, EndLine As Integer, NextLine As Integer
Dim WkbCopy As Workbook, WksCopy As Worksheet, Fso As Object, File As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set WksHome = Workbooks(HomeDatei).Sheets(HomeDaten)
Set WksList = Workbooks(HomeDatei).Sheets(HomeListe)
EndLine = GetEndLine(WksHome):  NextLine = HomeZeile
If EndLine >= HomeZeile Then WksHome.Rows("3:" & EndLine).Cells.Clear
Application.ScreenUpdating = False
For Each File In WksList.Range(ListDatei).CurrentRegion
If Fso.FileExists(File) = False Then
Application.ScreenUpdating = True
MsgBox ErrMsg & File, vbExclamation, "Fehler":  Exit Sub
End If
Set WkbCopy = Workbooks.Open(File):  Set WksCopy = WkbCopy.Sheets(1)
EndLine = GetEndLine(WksCopy)
If EndLine >= CopyZeile Then
WksCopy.Rows("3:" & EndLine).Copy
WksHome.Rows(NextLine).Insert Shift:=xlDown
Application.CutCopyMode = False
WkbCopy.Saved = True:  WkbCopy.Close
NextLine = GetEndLine(WksHome) + 1
End If
Next
Application.ScreenUpdating = True
End Sub

AW: Inhalt von Blättern nacheiander in neuer Mappe

15.07.2011 14:04:28

Blättern

Hallo Carsten,
so vllt.; in einer 'Import'-Arbeitsmappe, Tabelle "Liste" sind die Pfad- und Dateiangaben der 'fremden' Arbeitsmappen untereinander in der Spalte A, beginnend in A1, aufgeführt. In der Tabelle 'Daten' der 'Import'-Arbeitsmappe sollte wenigstens in 'A1' eine Überschrift stehen. Folgendes Makro würde die Daten nacheinander in die Tabelle Daten importieren:
Option Explicit

Sub Datensammler()
Dim mySh, myShZiel As Worksheet
Dim dl As Long
Set mySh = ActiveWorkbook.Sheets("Importliste")
Set myShZiel = ActiveWorkbook.Sheets("Daten")
For dl = 1 To mySh.[A1].End(xlDown).Row
Workbooks.Open mySh.Cells(dl, 1)
ActiveWorkbook.Sheets("Protokoll").UsedRange.Copy _
Destination:=myShZiel.Cells(myShZiel. _
Cells(myShZiel.Rows.Count, 1).End(xlUp).Row + 1, 1)
ActiveWorkbook.Close savechanges:=False
Next
End Sub

Gruß
Jochen

Beliebteste Forumthreads (12 Monate)

Inhalt von Blättern nacheiander in neuer Mappe

Forumthread: Inhalt von Blättern nacheiander in neuer Mappe

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread