AW: Arbeitsblatt kopieren
21.02.2018 13:26:52
Michael
Hallo!
Routine und Funktion für die Ziel-Mappe, in der die Werte gesammelt werden sollen (.xlsm).
Routine a öffnet die Datei am angegebenen Speicherort und geht die Blätter durch: existiert in der Ziel-Datei bereits ein Blatt mit gleichem Namen werden dessen Zellen gelöscht, und die Zell-Werte des korrespondierenden Quell-Blattes eingetragen. Existiert in der Ziel-Datei noch kein Blatt mit gleichem Namen, wird es angelegt und die Zell-Werte des korrespondierenden Blattes werden eingetragen.
Sub a()
Dim WbZ As Workbook: Set WbZ = ThisWorkbook
Dim WsZ As Worksheet, WbQ As Workbook, WsQ As Worksheet
Application.ScreenUpdating = False
Set WbQ = Workbooks.Open("C:\DeinVerzeichnis\DeineDatei.xlsx")
For Each WsQ In WbQ.Worksheets
Select Case BlattDa(WbZ, WsQ.Name)
Case True
Set WsZ = WbZ.Worksheets(WsQ.Name)
WsZ.UsedRange.Clear
WsQ.UsedRange.Copy
WsZ.Cells(1, 1).PasteSpecial xlPasteValues
Set WsZ = Nothing
Case False
Set WsZ = WbZ.Worksheets.Add(after:=WbZ.Worksheets.Count)
WsQ.UsedRange.Copy
WsZ.Cells(1, 1).PasteSpecial xlPasteValues
WsZ.Name = WsQ.Name
Set WsZ = Nothing
End Select
Next WsQ
WbQ.Close False
Set WbZ = Nothing: Set WsZ = Nothing: Set WbQ = Nothing: Set WsQ = Nothing
End Sub
Function BlattDa(Wb As Workbook, Sh As String) As Boolean
Dim Ws As Worksheet
b = False
For Each Ws In Wb.Worksheets
If Ws.Name = Sh Then b = True
Next Ws
End Function
LG
Michael