Herbers Excel-Forum - das Archiv

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

Excel-Beispiele zum Thema "Tabellenblatt kopieren"
Benennen von Tabellenblättern mit Monatsnamen Druckseitenlinien im Tabellenblatt
Tabellenblattnamen in ein Listenfeld einlesen Suchbegriff über mehrere Tabellenblätter suchen.
Tabellenblätter benennen Tabellenblatt auswählen
Zustand von Tabellenblatt-Checkboxes ermitteln Tabellenblattnamen der VBE-Projekte ändern
Tabellenblattnamen nach Datum Gefilterte Daten in neues Tabellenblatt übertragen