Formel in Zelle anpassen (Tricky)

Hallo Forum,
habe folgende Aufgabenstellung und komme nicht weiter:
Per VBA Button wird ein Tabellenblatt kopiert und dessen Namen geändert:
z.B. aus Tabelle1 entsteht Tabelle2, aus Tabelle 2 entsteht Tabelle3 usw.
Nun befindet sich in einer Zelle A10 auf Tabelle1 ein Betrag(1000), auf Tabelle2 soll in A7 soll der Wert aus Tabelle1 als Übertrag stehen also:
Zelle A7=Tabelle1!A10
Ab Tabelle3 sollen in A7 die Werte von Tabelle2!A10 und Tabelle2!A7 zusammengerechnet werden also:
Zelle A7=Tabelle2!A10+Tabelle2!A7
In Tabelle4 dann in A7 die Werte von Tabelle3!A10 und Tabelle3!A7 zusammengerechnet werden also:
Zelle A7=Tabelle3!A10+Tabelle3!A7
in Tabelle5 dann in A7 die Werte von Tabelle4!A10 und Tabelle4!A7 zusammengerechnet werden also:
Zelle A7=Tabelle4!A10+Tabelle4!A7
usw.
Den Zahlenteil des Namens jeder Tabelle steht auf der Tabelle z.b. in A1 (Wenn es was hilft)
Hänge mal ein Beispiel ohne die Kopierfunktion bei.
https://www.herber.de/bbs/user/143768.xlsx
Vielen Dank fürs Kopf zerbrechen.
Gruß Manuel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Kopieren() Dim wb As Workbook Set wb = ThisWorkbook wb.Worksheets(wb.Worksheets.Count).Copy After:=wb.Worksheets(wb.Worksheets.Count) wb.Worksheets(wb.Worksheets.Count).Name = "Tabelle" & wb.Worksheets.Count If wb.Worksheets(wb.Worksheets.Count).Range("A7") = "" Then wb.Worksheets(wb.Worksheets.Count).Range("A7") = "=Tabelle" & wb.Worksheets.Count - 1 & _ "!A10" Debug.Print "if" Else Debug.Print "else" wb.Worksheets(wb.Worksheets.Count).Range("A7").Formula = wb.Worksheets(wb.Worksheets. _ Count).Range("A7").Formula & "+Tabelle" & (wb.Worksheets.Count - 1) & "!A10" End If Set wb = Nothing End Sub

Private Sub CommandButton1_Click() Dim wb As Workbook Set wb = ThisWorkbook wb.Worksheets("AR.1").Copy After:=wb.Worksheets(wb.Worksheets.Count) wb.Worksheets(wb.Worksheets.Count).Name = "AR." & (wb.Worksheets.Count - 2) If wb.Worksheets.Count = 4 Then wb.Worksheets(wb.Worksheets.Count).Range("F43").Formula = "=AR." & wb.Worksheets.Count - _ 3 & _ "!F53" Debug.Print "if" Else wb.Worksheets(wb.Worksheets.Count).Range("F43").Formula = "=AR." & wb.Worksheets.Count - _ 3 & "!F43+" & _ "AR." & wb.Worksheets.Count - 3 & "!F53" Debug.Print "else" End If wb.Worksheets(wb.Worksheets.Count).Range("F40").Formula = "=AR." & wb.Worksheets.Count - 3 & _ "!F40+" & _ "AR." & wb.Worksheets.Count - 2 & "!F43" Set wb = Nothing End Sub

Hallo Tobias,
vielen Dank. Musste noch eine kleine Anpassung machen.


Sub Blatt_kopieren_und_ans_Ende_stellen()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Worksheets("AR.1").Copy After:=wb.Worksheets(wb.Worksheets.Count)
wb.Worksheets(wb.Worksheets.Count).Name = "AR." & (wb.Worksheets.Count - 3)
If wb.Worksheets.Count = 5 Then
wb.Worksheets(wb.Worksheets.Count).Range("F43").Formula = "=AR." & wb.Worksheets.Count - _
_
4 & _
"!F53"
Debug.Print "if"
Else
wb.Worksheets(wb.Worksheets.Count).Range("F43").Formula = "=AR." & wb.Worksheets.Count - _
_
5 & "!F53+" & _
"AR." & wb.Worksheets.Count - 4 & "!F53"
Debug.Print "else"
End If
wb.Worksheets(wb.Worksheets.Count).Range("F40").Formula = "=AR." & wb.Worksheets.Count - 4 & _
_
"!F40+" & _
"AR." & wb.Worksheets.Count - 3 & "!F39"
Set wb = Nothing
'Werte aus der vorangegangenen Tabelle entfernen
Range("F27").Value = 0
Range("F29").Value = 0
Range("F31").Value = 0
Range("F47").Value = 0
'Werte anpassen für Überträge und geleistete Zahlungen
Range("A20").Value = Range("A20").Value + 1
Range("A43").Value = "13."
Range("B43").Value = "bisher geleistete Zahlungen"
Range("F43").NumberFormat = "#,##0.00 ;[Red]#,##0.00 "
Range("A47").Value = "14."
'Farben der Tabellenblätter anpassen
If Range("F53").Value = "0" Then
ActiveSheet.Tab.ColorIndex = 3 'rot
Else
ActiveSheet.Tab.ColorIndex = 43 'grün
End If
Sheets(ActiveSheet.Index - 1).Select
If Range("H27").Value = "ÜBERZAHLT" Then
ActiveSheet.Tab.ColorIndex = 3 'rot
Else
ActiveSheet.Tab.ColorIndex = 43 'grün
End If
Sheets(ActiveSheet.Index + 1).Select
End Sub

Ich hatte eine Funktion eingebaut die den Zellwert von A20 bei jeder Kopie um 1 erhöht.
Allerdings funktioniert "Range("A20").Value = Range("A20").Value + 1" nur noch bis zur 1. Kopie von AR.1 (also AR.2), danach bleibt der Wert der Zelle A20 immer 2 statt sich automatisch um 1 zu erhöhen.
Das hat mit einer anderen Kopiermethode immer funktioniert.
Im Endeffekt müsste in A20 immer der Zahlwert des Tabellennamens stehen. Vielleicht gibts ja da noch ne andere Lösung.
Kannst du da nochmal nachschauen?
Vielen Dank

Beliebteste Forumthreads (12 Monate)

Formel in Zelle anpassen (Tricky)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Formel in Zelle anpassen (Tricky)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread