1 Blatt in mehrere neu erstellte Blätter kopieren
20.04.2016 15:38:58
K.
ich habe folgenden VBA-Code und komme bei einer Sache nicht weiter:
Private Sub Workbook_Open()
Worksheets("countries").Columns(1).ClearContents
Dim source As Range
Dim target As Range
Set source = Range("[CeBIT.xlsx]Source!countries")
Set target = Range("A1")
source.EntireColumn.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=source.EntireColumn, CopyToRange:=target, Unique:=True
Rows("1:2").Delete
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name "countries" Then ws.Delete
Next
Application.DisplayAlerts = True
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("countries").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value
Next MyCell
Worksheets("countries").Activate
End Sub
Das Makro hat am Ende neue Blätter erstellt, benannt nach Namen aus einer Liste. Das erste Tabellenblatt in der Datei x ist statisch und heißt "countries", alle anderen Blätter (65 Stück) sind neu.
Nun will ich in jedes dieser neuen Blätter ein bestimmtes ganzes Tabellenblatt aus einer anderen Datei y kopieren , aber gefiltert. Das heißt, dass er die ersten beiden ganzen Zeilen (header) und zusätzlich alle anderen ganzen Zeilen nehmen soll, die das gesuchte Land in der Spalte J ab J3 in dem Quellentabellenblatt in der Datei y enthalten. Das heißt, dass er in der Datei y nach dem Tabellenblattnamen des neue erstellten Tabellenblattes in der Datei x filtern muss.
Wie schaffe ich das?