Ranges untereinander kopieren in loop(WB+WS)
27.06.2013 10:09:05
Tobias
Ich habe eine Frage und hoffe mir kann jemand helfen.
Ich habe einen Ordner mit 10 .xls Dateien, die öffnen ich nacheinander (das klappt) jetzt möchte ich falls in Cells(11,1) etwas steht die letzte Zeile und die letzte Spalte ermitteln und den damit eingrenzenden Bereich in das erste Worksheet des Workbooks kopieren, in dem der VBA Code steht. Dies soll für alle Tabs zwischen 3 und 14 geschehen. Die Ranges die aus den Tabs kopiert werden sollen dann untereinander eingefügt werden. Dann gehts zum nächsten Workbook und das gleiche Spielt geht von vorne los, so dass ich alle Ranges aus den Workbooks untereinander habe.
Mein Code dazu funktioniert leider nicht. Er läuft zwar durch, kopiert aber nichts rüber:
Sub test()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim wbQuelle As Workbook
Dim folderpath As String
Dim i As Integer
folderpath = "C:\test"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(folderpath)
For Each oFile In oFolder.Files
If Right(oFile.Name, 3) = "xls" Then
Application.ScreenUpdating = False
End If
Set wbQuelle = Workbooks.Open(oFile.path)
call action2()
wbQuelle.Close
Next
'Application.ScreenUpdating = True
End Sub
Sub aktion2()
Dim letzteZeileA As Long
Dim letzteSpalteA As Long
Dim letzteZeileThisWB As Long
Dim i As Integer
Dim strBereich As String
Dim relevanteTabs As Integer
For relevanteTabs = 3 To 14
With ActiveWorkbook.Worksheets(relevanteTabs)
letzteZeileA = .Cells(Rows.Count, 1).End(xlUp).Row
letzteSpalteA = .Cells(1, Columns.Count).End(xlToLeft).Row
letzteZeileThisWB = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp). _
Row
If .Range(.Cells(11,1)) "" then
strBereich = .Range(.Cells(11, 1), .Cells(letzteZeileA, letzteSpalteA))
.Range(strBereich).Copy
ThisWorkbook.Worksheets(1).Cells(1, letzteZeileThisWB + 1).PasteSpecial Past:= _
xlPasteValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False
end if
End With
Next relevanteTabs
End Sub