Kopiern von Tabellenblättern

Public Sub Kopieren()
Dim QWB As Workbook
Dim zwb As Workbook
Dim QWS As Worksheet
Dim ZWS As Worksheet
Dim Woche as integer
Dim lngCalc As Long
Dim wkbNeu As Workbook
Dim strPfad As String
Dim strName As String
Dim Dateiname As String
Woche = ThisWorkbook.Sheets("teams").Range("C1")
strPfad = ThisWorkbook.Path & "\"
strName = "Test_V5_KW_" & Woche & "_OF.xlsx"
Set wkbNeu = Workbooks.Add
wkbNeu.SaveAs strPfad & strName
Workbooks(strName).Activate
With Workbooks(strName)
.Sheets.Add
.Sheets(1).Name = "Daten1"
.Sheets(2).Name = "Daten2"
.Sheets(3).Name = "Daten3"
.Sheets(4).Name = "Daten4"
End With
Dateiname = Dir(strPfad & strName)
ThisWorkbook.Activate
Sheets("Daten1").Select
ActiveSheet.Copy
Workbooks(Dateiname).Activate
With Workbook(Dateiname)
.Sheets("Daten1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End Sub