VBA für Bedingtes Zeilen kopieren und einfügen via C.Button

[Liunil]

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.

[schauan]

Hallöchen,

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" ?

[Liunil]

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.

[schauan]

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

[Liunil]

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.

[schauan]

Hallöchen,
Oben drüber bei dem anderen With...