AW: Werte aus mehreren Mappen kopieren
03.11.2011 03:35:01
CitizenX
Hi,
nicht perfekt aber sollte so gehen:
Code in ein allgem. Modul deiner Auswertungsmappe kopieren
Option Explicit
Sub allewerte()
Dim i&, lngLast&, strPath$, strDat$
Dim oWbk As Workbook
Application.ScreenUpdating = False
i = 9
strPath$ = Dir(ThisWorkbook.Path & "\*Mappe*20*" & i & ".xls")
Do While strPath$ ""
Set oWbk = GetObject(ThisWorkbook.Path & "\" & strPath$)
lngLast = Application.Max(ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp). _
Row + 1, 2)
ThisWorkbook.Sheets("Tabelle1").Cells(lngLast, 1).Resize(1, 4).Value = oWbk.Worksheets("Ü _
bersicht").Range("A4:E4").Value 'ggf anpassen
oWbk.Close
i = i + 1
strPath$ = Dir(ThisWorkbook.Path & "\*Mappe*20*" & i & ".xls")
Loop
Application.ScreenUpdating = True
Set oWbk = Nothing
End Sub
Grüße
Steffen