Hallo zusammen ich möchte ein Tabellenblatt (01.01.02) mit inhalt und formatierung mehrfach kopieren (VBA) z.B. bis zum (31.12.02)in A1 soll dann jeweils der Tabellenblattname (Datum ) stehen
habe schon durch die Hilfe von Werner B. folgendes Script bekommen welches auch super funzt allerdings fehlt jetzt noch das kopieren der Tabelle (01.01.02) schon mal vielen dank an alle hier das script:
Option Explicit
Sub BlaNaDatum()
Dim BlaNa As String
Dim i As Byte
Application.ScreenUpdating = False
'Januar
For i = 2 To 31
BlaNa = "0" & i & ".01.02"
If i > 9 Then BlaNa = i & ".01.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'Februar
For i = 1 To 28
BlaNa = "0" & i & ".02.02"
If i > 9 Then BlaNa = i & ".02.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'März
For i = 1 To 31
BlaNa = "0" & i & ".03.02"
If i > 9 Then BlaNa = i & ".03.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'April
For i = 1 To 30
BlaNa = "0" & i & ".04.02"
If i > 9 Then BlaNa = i & ".04.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'Mai
For i = 1 To 31
BlaNa = "0" & i & ".05.02"
If i > 9 Then BlaNa = i & ".05.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'Juni
For i = 1 To 1
BlaNa = "0" & i & ".06.02"
If i > 9 Then BlaNa = i & ".06.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub BlaNaDatum()
Dim BlaNa As String
Dim i As Byte
Application.ScreenUpdating = False
'Januar
For i = 2 To 31
BlaNa = "0" & i & ".01.02"
If i > 9 Then BlaNa = i & ".01.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'Februar
For i = 1 To 28
BlaNa = "0" & i & ".02.02"
If i > 9 Then BlaNa = i & ".02.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'März
For i = 1 To 31
BlaNa = "0" & i & ".03.02"
If i > 9 Then BlaNa = i & ".03.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'April
For i = 1 To 30
BlaNa = "0" & i & ".04.02"
If i > 9 Then BlaNa = i & ".04.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'Mai
For i = 1 To 31
BlaNa = "0" & i & ".05.02"
If i > 9 Then BlaNa = i & ".05.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
'Juni
For i = 1 To 1
BlaNa = "0" & i & ".06.02"
If i > 9 Then BlaNa = i & ".06.02"
Sheets("01.01.02").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = BlaNa
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
.Properties("_CodeName").Value = "Tabelle" & Sheets.Count
End With
ActiveSheet.Range("A1").Value = Format(BlaNa, "@")
Next i
Application.ScreenUpdating = True
End Sub