Supportnet / Forum / Tabellenkalkulation
Makroproblem
Frage
Hallo,
ich habe folgenede Makro, in der ich aus Tabellen, die in einem Ordner drinen sind öffne und aus mehreren Tabellenblättern in eine andere Datei was rauskopieren will.
Das Problem ist, dass es wenn es einen wert in die Gesamtdatei kopiert hat für die Zweite Information nicht mehr rüberspringt. Der Dateiname ändert sich natürlich auch immerwieder, kommt drauf an welche Datei grad geöffnet ist..
Vielleicht kann mir jemand einen Befehl verraten, der mir das ermöglicht.
Danke
Hier ist die Makro zur Info
Option Explicit
Sub MappenErfassung()
Dim Mappen As Integer
Dim zeile As Integer
Dim Letztezeile As Integer
With Application.FileSearch
.NewSearch
.LookIn = "S:\_Temp\\Kopie"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
ActiveWindow.ScrollRow = 1
Sheets("Plan").Select
Range("C5:G5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("BP.xls").Activate
Sheets("Gesamt").Select
zeile = Range("A65536").End(xlUp).Row
Rows(zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollRow = 1
Sheets("Spiel").Select
Range("G22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("BP.xls").Activate
Sheets("Gesamt").Select
zeile = Range("B65536").End(xlUp).Row
Rows(zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollRow = 1
Sheets("Hier").Select
Range("G28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("BP.xls").Activate
Sheets("Gesamt").Select
zeile = Range("B65536").End(xlUp).Row
Rows(zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollRow = 1
Sheets("Top").Select
Range("G28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("BP.xls").Activate
Sheets("Gesamt").Select
zeile = Range("c65536").End(xlUp).Row
Rows(zeile + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(2).Close
Next Mappen
End If
End With
End Sub