Zellen aus Dateien in einer Zusammenführen/kopiere
04.09.2013 14:05:35
Roland
ich möchte aus mehreren Dateien, die alle den selben Aufbau haben, ein paar Zellen herauskopieren und diese in eine neue Datei nebeneinander einfügen.
Es soll aus der Mustertabelle die Zellen D13, L13, L14, L15 in einer neuen Datei in einer Zeile geschrieben werden.
Ich habe einen Code schon gefunden (Vielen Dank hier an Gerd) der momentan ganze Tabellenblätter kopiert. Ich wollte diesen Code verändern, er Funktioniert leider aber nicht in meiner Arbeitsmappe so dass ich diesen auch nicht verändern oder anpassen kann.
Könnt Ihr mir vielleicht kurz helfen was ich da anpassen muss.
https://www.herber.de/bbs/user/87148.xls
Sub NUR_Kompiliert()
'(cu :-)Gerd
Dim Datei As String
Dim WB As Workbook, strWS As String
Dim rngQ As Range, rngZ As Range
Dim Pfad As String
Pfad = "U:\rfiguli\DOP - Excel Dateien\" 'Pfad _
'angepasst
Datei = Dir(Pfad & "*.xls")
Application.ScreenUpdating = False
'Active Mappe
Set WB = ActiveWorkbook
strWS = ActiveSheet.Name
Do While Datei ""
'Öffnet eine Datei
Workbooks.Open Datei
'Kopiert von den Zeilen 2 bis zum Ende
'in die aktive Mappe und fügt sie jeweils unten an
Set rngQ = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).EntireRow
Set rngZ = WB.Worksheets(strWS).Cells(WB.Worksheets(strWS).Rows.Count, 1).End(xlUp).Offset( _
1, 0).Resize(rngQ.Rows.Count, rngQ.Columns.Count)
rngQ.Copy Destination:=rngZ
'Schliesst die geöffnete Datei
ActiveWorkbook.Close False
'Prüft für die nächste Datei
Datei = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Vielen Dank
Roland
Anzeige