Tabellenblatt kopieren



Excel-Version: 2000
nach unten

Betrifft: Tabellenblatt kopieren
von: René
Geschrieben am: 24.04.2002 - 18:11:58

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

nach oben   nach unten

Re: Tabellenblatt kopieren
von: WernerB.
Geschrieben am: 24.04.2002 - 19:10:38

Hallo René, warum machst Du hier einen neuen Thread auf? In Deinem alten Thread habe ich Dir bereits geantwortet. Ich verstehe auch nicht, was Du mit "Tabelle kopieren" meinst. Alle neuen Blätter sind eine Kopie des Blattes "01.01.02" und beinhalten somit automatisch alle Inhalte und Formatierungen dieses Blattes. Wenn Du es mit dieser Vorlage nicht schaffst, die restlichen Tage des Jahres selbst zu programmieren, dann lass es mich wissen - dann liefere ich Dir das auch noch (in Deiner ersten Anforderung wolltest Du es aber nur bis zum 01.06.02 haben). MfG WernerB.

nach oben   nach unten

Re: Tabellenblatt kopieren
von: René
Geschrieben am: 24.04.2002 - 19:58:54

Sorry Werner hab gepennt ,funzt natürlich alles so wie du geschrieben hast Entschuldige bitte,

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Tabellenblatt kopieren"