Gesamtübersicht erstellen

Hallo Forum!
Habe ein Problem:
Ich habe 4 Dateien (siehe unten const1-const4). In diesen Dateien stehen in dem Sheet Gesamt die Datensätze, die ich in eine neue Datei Mappe1.xls kopieren möchte. Das Sheet Gesamt hat in allen 4 Dateien diesen Namen und ist spaltentechnisch identisch aufgebaut. Das Makro soll jetzt diese 4 Dateien automatisch öffnen und die Werte in die Tabelle1 der Datei Mappe1.xls nahtlos aneinander kopieren.
Wie gesagt der Aufbau der Spalten ist identisch, die Anzahl der Datensätze kann sich unterscheiden.
Was muss ich in meinem Makro noch ergänzen, damit es läuft!?


Sub Gesamtuebersicht()
Dim strTab$
Dim Spa As Long
strTab = "Tabelle1"
Const1 AM_Datei = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe5.xls"
Const2 AA_Datei = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe6.xls"
Const3 DE_Datei = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe7.xls"
Const4 EU_Datei = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe8.xls"
Kopieren der Dateneinträge aus der AM_Datei Sheet Gesamt in die Tabelle1 der Mappe1.xls
Workbooks.Open AM_Datei
Worksheets("Gesamt").Activate
Spa = Sheets("Gesamt").Cells(Rows.Count, 1).End(xlUp).Row
Sheets(strTab).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(Spa - 1, 256).Value = _
Sheets(Gesamt).Rows("2:" & Spa).Value
´Die Werte aus den anderen Dateien (AA, DE, EU) sollen nahtlos in die Tabelle 1 der Mappe1.xls   _
_
kopiert werden. Somit stehen am Ende alle Einträge aus den 4 Dateien in der Tabelle 1 der  _
Mappe1.xls.
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Gesamtuebersicht() Dim wbNeu As Workbook Dim Dat(3) As String Dim i As Long Dat(0) = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe5.xls" Dat(1) = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe6.xls" Dat(2) = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe7.xls" Dat(3) = "I:\Ordnerlevel_1\Ordnerlevel_2\Mappe8.xls" Set wbNeu = Workbook.Add For i = 0 To UBound(Dat, 1) Workbooks.Open Dat(i), ReadOnly:=True ActiveWorkbook.Sheets("Gesamt").UsedRange.Copy wbNeu.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial _ xlPasteValuesAndNumberFormats ActiveWorkbook.Saved = True ActiveWorkbook.Close Next wbNeu.Sheets(1).Rows(1).Delete end sub

Sub Gesamtuebersicht() Dim strTab$ Dim Spa As Long Dim arrDateien, i As Integer, wks As Worksheet strTab = "Tabelle1" Const strPfad As String = "I:\Ordnerlevel_1\Ordnerlevel_2\" arrDateien = Array("Mappe5.xls", "Mappe6.xls", "Mappe7.xls", "Mappe8.xls") 'Kopieren der Dateneinträge aus der AM_Datei Sheet Gesamt in die Tabelle1 der Mappe1.xls For i = 0 To 3 Set wks = Workbooks.Open(strPfad & arrDateien(i)).Sheets("Gesamt") Spa = wks.Cells(Rows.Count, 1).End(xlUp).Row ThisWorkbook.Sheets(strTab).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(Spa - 1, 256) _ .Value = _ wks.Rows("2:" & Spa).Value wks.Parent.Close False Next i End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread