Masterdatei für alle Dateien eines Ordners
29.08.2014 07:43:04
WalterK
mit dem nachfolgenden Code aus einem Forum wird aus allen Dateien eines Ordners das jeweils aktive Blatt in 1 Masterdatei kopiert. Funktioniert tadellos.
Wir müsste der Code geändert werden, damit alle Blätter aller Dateien in die Masterdatei kopiert werden.
Hier noch der Code:
Option Explicit
Sub zusammenfuegen()
Dim strDateiname As String
Dim wksZiel As Worksheet, wkbQuelle As Workbook, wksQuelle As Worksheet
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xls")
Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
Do While strDateiname ""
If strDateiname ThisWorkbook.Name Then
Set wkbQuelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strDateiname)
Set wksQuelle = ActiveSheet 'ggf. = wkbQuelle.Worksheets(1)
loLetzte1 = wksZiel.UsedRange.SpecialCells(xlCellTypeLastCell).Row
With wksQuelle
loLetzte2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
inLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
.Range(.Cells(3, 1), .Cells(loLetzte2, inLetzte)).Copy _
Destination:=wksZiel.Cells(loLetzte1 + 1, 1)
End With
wkbQuelle.Close True
End If
strDateiname = Dir
Loop
Set wkbQuelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
Application.ScreenUpdating = True
End Sub