Automatisches Kopieren & Löschen v. sheets
30.08.2005 07:37:25
Stephan
Ich habe eine Frage: in folgendem Code (nicht von mir) wird ein Template-Sheet kopiert & mit den Namen in den Feldern B5-B19 (müssen nicht alle voll sein) eingefügt bzw. Daten dieser neuen Sheets übernommen.
Dazu die Frage:
- Kann man verhindern, dass eine Fehlermeldung kommt, wenn nicht alle Namen hintereinander stehen sondern eine leere Zelle dazwischen ist?
- Wie kann ich nachträglich ein Sheet einfügen, d.h. ein zusätzlicher Name kommt dazu, die übrigen sollten aber nicht mehr überschrieben werden.
- Gibt es die Möglichkeit, nachträglich einzelne Sheets zu löschen, z.b. über eine Auswahlfeld?
Vielen Dank für eure Hilfe!
Stephan
Sub create_subproject_sheets()
Dim i As Integer, strName As String
Application.ScreenUpdating = False
For i = 5 To Sheets(1).Cells(20, 2).End(xlUp).Row
strName = Sheets(1).Cells(i, 2)
Sheets(2).Copy after:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = strName
.Range("F1") = strName
End With
With Sheets(1).Rows(25 + i)
.Cells(2) = strName
.Cells(5).FormulaLocal = "='" & strName & "'!$E$1"
.Cells(6).FormulaLocal = "='" & strName & "'!$BB$5"
.Cells(7).FormulaLocal = "='" & strName & "'!$BB$6"
.Cells(9).FormulaLocal = "='" & strName & "'!$BB$7"
.Cells(10).FormulaLocal = "='" & strName & "'!$BB$8"
.Cells(12).FormulaLocal = "='" & strName & "'!$BB$9"
.Cells(13).FormulaLocal = "='" & strName & "'!$E$3"
.Cells(14).FormulaLocal = "='" & strName & "'!$L$1"
.Cells(15).FormulaLocal = "='" & strName & "'!$L$2"
End With
Next i
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub
Anzeige