(18.08.2022, 08:38)schauan schrieb: [ -> ]Hallöchen,
dann starte es am Ende vom Click-Makro, indem Du dort den Namen einfügst.
Danke für deine Idee, nur kann ich das so nicht einfach übernehmen, da die kopierte Zeile in verschiedene Tabellen kopiert wird und nicht nur in "Rechnungen". Ich habe mal eine "Muster" Datei angehängt.
Wird auf der Hauptseite die Zeile ausgefüllt und auf übertragen gedrückt, wir die Zeile in eine entsprechende Tabelle kopiert. Diese soll dann automatisch neu nach Datum sortiert werden.
Hallöchen,
Zitat:Wird auf der Hauptseite die Zeile ausgefüllt und auf übertragen gedrückt, wir die Zeile in eine entsprechende Tabelle kopiert. Diese soll dann automatisch neu nach Datum sortiert werden
Mit "Diese" meinst Du die "entsprechende Tabelle" ?
(18.08.2022, 09:17)schauan schrieb: [ -> ]Hallöchen,
Mit "Diese" meinst Du die "entsprechende Tabelle" ?
Jupp, ich dachte mir, wenn die Zeile in die "entsprechende Tabelle" kopiert wurde, dass dann die Tabelle gleich neu sortiert wird.
Sprich, wenn die Zeile in Rechnungen kopiert wird, soll diese Tabelle neu sortiert werden. Wird in Versicherungen kopiert, soll diese neu sortiert werden.
Hallöchen,
also, dann fassen wir mal beide Makros zusammen. Im Click-Makro hast Du diesen Teil:
Code:
With Worksheets("Steuer")
.Rows("4:4").Insert Shift:=xlDown
Me.Range("A5:F5").Copy .Range("A5")
End With
Den erweiterst Du mit dem Sortieren,
Worksheets("Rechnungen").Range("A4:F1000").Sort Key1:=Worksheets("Rechnungen").Range("A4"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
dabei wird der Blattname weggelassen, sieht dann so aus ...
Code:
With Worksheets("Steuer")
.Rows("4:4").Insert Shift:=xlDown
Me.Range("A5:F5").Copy .Range("A5")
.Range("A4:F1000").Sort Key1:=.Range("A4"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Also so funktioniert es aber nur auf der "Steuer" Tabelle. Nicht aber auf der "Rechnungen" Tabelle
Code:
Private Sub Übertragen_Click()
Dim strTabName As String
strTabName = Me.Range("B5").Value
If strTabName = "" Then
MsgBox "Kategorie fehlt noch!", vbInformation
Else
With Worksheets(strTabName)
.Rows("4:4").Insert Shift:=xlDown
Me.Range("A5:F5").Copy .Range("A5")
.Range("A4:F1000").Sort Key1:=.Range("A4"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
If Me.Range("F5").Value = "x" Then
With Worksheets("Steuer")
.Rows("4:4").Insert Shift:=xlDown
Me.Range("A5:F5").Copy .Range("A5")
.Range("A4:F1000").Sort Key1:=.Range("A4"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End If
Me.Range("A5:F5").ClearContents
End If
End Sub
Habe es jetzt so gelöst.
Hallöchen,
Oben drüber bei dem anderen With...