ich habe eine (Für Euch sicherlich einfache) Frage:
Ich lege per Dialogbox Tabellenblätter an.
es werden zB. 2 Tabellenblätter angelegt (Kope von vorhandenen Blättern)
Jetzt sollen in einer Haupttabelle Zellenverweise gesetzt werden. (Die Zelle A7 ist immer gleich)
Name: Pos. 1, Pos. 2, Pos. 3, usw.
Ich habe folgende Variablen:
aktuellessheet = Name des letzten angelegten Blatts
Verweis der in die Tabelle geschrieben werden soll:
= "[Blattname des letzten Blatts (hier: aktuellessheet)]" & '[Blattname des letzten Blatts (hier: aktuellessheet)]'!A7
Beispiel: ="Pos. 1" & 'Pos. 1'!A7
Ich habe alles möglich ausprobiert aber irgendwie will es nicht.
Skript:
Sub NeueBlätter()
Application.ScreenUpdating = False
start:
Dim AnzahlBlätter As String
Dim Blattname As String
Dim Frage As Single
Dim Aktivezelle As String
Dim posnr As String
Dim aktuellessheet As String
Rem On Error GoTo ende
Rem Zelle I1 und I2 mit Anzahl der Positionen füllen
Sheets("Gesamtübersicht").Range("Gesamtübersicht!i1").Value = (Worksheets.Count - 3)
Range("Gesamtübersicht!i2").Value = ((Worksheets.Count - 3) / 2)
Rem Eingabe Anzahl der neuen Positionen
AnzahlBlätter = InputBox("Anzahl Blätter eingeben:", "Bitte eine durch 2 teilbare Zahl eingeben")
If AnzahlBlätter = "" Then GoTo schluss Else 'Fehlermeldung abfangen
Frage = Worksheets.Count - 2
For i = Frage To AnzahlBlätter + Frage - 1
Rem Blätter anlegen
Blattname = ("Pos. " & i)
Worksheets.Add
ActiveSheet.Name = Blattname
If i / 2 = Int(i / 2) Then GoTo ungerade Else GoTo gerade
gerade:
Sheets("Mk_Vorlage").Select
Cells.Select
Selection.Copy
ActiveSheet.Range("a1").Select
Sheets("Pos. " & i).Select
Cells.Select
ActiveSheet.Paste
ActiveSheet.Range("a1").Select
Rem Gesamtübersicht ausfüllen
MsgBox ("i = " & i)
Aktivezelle = ("A" & (20 + i))
aktuellessheet = ("Pos. " & i)
MsgBox (aktuellessheet)
MsgBox ("Aktivezelle= " & Aktivezelle)
Sheets("Gesamtübersicht").Select
posnr = ("Pos. ")
Range(Aktivezelle).Formula = "=""" & aktuellessheet " Hier soll die Formel geschrieben werden!
GoTo next_i
ungerade:
Sheets("Lk_Vorlage").Select
Cells.Select
Selection.Copy
ActiveSheet.Range("a1").Select
Sheets("Pos. " & i).Select
Cells.Select
ActiveSheet.Paste
ActiveSheet.Range("a1").Select
next_i:
Next i
GoTo schluss
ende:
MsgBox ("Fehler in der Eingabe!")
GoTo start
schluss:
Sheets("Gesamtübersicht").Move before:=Sheets(1)
Range("Gesamtübersicht!i1").Value = (Worksheets.Count - 3)
Range("Gesamtübersicht!i2").Value = ((Worksheets.Count - 3) / 2)
Application.ScreenUpdating = True
End Sub