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

[Liunil]

Moin zusammen,

ich hoffe, hier kann mir geholfen werden.

Folgende Funktion möchte ich erreichen:

Nachdem in Tabelle "Haupt" die Zellen A4-E4 gefüllt sind, soll via C.Button ("Übertragen") diese Zeilen inkl. Formatierung (Hyperlink in B4) in andere Tabellen übertragen werden. Und zwar wird in C4 in Haupt mittels DropDown eine Kategorie ausgewählt. Für je dieser Kategorien gibt es eine entsprechende Tabelle. Also soll, je nach ausgewählter Kategorie, die Zeilen dorthin kopiert werden und anschließend die Zeilen in "Haupt" wieder geleert werden.
Über die einzelnen Buttons auf der Hauptseite soll man nur direkt in die entsprechende Tabelle springen. Diesen funktioniert auch soweit.

Bei zwei Buttons (Rechnungen und Versicherungen) funktioniert noch die Copy/Paste funktion, welche ich aber über den Übertragen Button lösen möchte. Also ist diese "veraltet". Habe ich zur Veranschaulichung noch drin gelassen.


Zusätzlich zu dem ganzen wird in der Zelle E4 unter umständen ein X gesetzt. Sollte dieses so sein, so soll diese Zeile zusätzlich in die Tabelle "Steuer" kopiert werden.

Hoffentlich konnte ich einigermaßen erklären, was ich machen möchte. Am Ende soll es eine kleine Dokumentenablage werden.

Vielen Dank auf jedenfall schonmal an jeden, der sich damit beschäftigen mag.

[Kuwer]

Hallo,

Code:

Private Sub Übertragen_Click()
  With Worksheets(Range("C4").Value)
    .Rows("3:3").Insert Shift:=xlDown
    Me.Range("A4:E4").Copy .Range("A3")
  End With
  If Me.Range("E4").Value = "X" Then
    With Worksheets("Steuer")
      .Rows("3:3").Insert Shift:=xlDown
      Me.Range("A4:E4").Copy .Range("A3")
    End With
  End If
  Me.Range("A4:E4").ClearContents
End Sub

Gruß Uwe

[Liunil]

Moin Uwe,

vielen Dank für deine Lösung. Funktioniert wie gewollt.

Kannst du mir noch etwas erläutern? Woher weiß die kopierte Zeile jetzt, wo (also in welche Tabelle) jetzt eingefügt werden soll? Welche passage im VBA definiert das jetzt?

Danke schonmal für deine Mühen

Gruß Alex

[{Boris}]

Hi,

kleiner Tipp: Einfach mal F1 drücken  - und dabei den Cursor vorher z.B. auf das Wort With stellen.

[Kuwer]

Hallo,

habe es noch etwas erweitert. Der Variable strTabName wird der Wert der Zelle C4 übergeben. Anschließend wird geprüft, ob Variable leer ist oder nicht.

Code:

Private Sub Übertragen_Click()
  Dim strTabName As String
  strTabName = Me.Range("C4").Value
  If strTabName = "" Then
    MsgBox "Kategorie fehlt noch!", vbInformation
  Else
    With Worksheets(strTabName)
      .Rows("3:3").Insert Shift:=xlDown
      Me.Range("A4:E4").Copy .Range("A3")
    End With
    If Me.Range("E4").Value = "X" Then
      With Worksheets("Steuer")
        .Rows("3:3").Insert Shift:=xlDown
        Me.Range("A4:E4").Copy .Range("A3")
      End With
    End If
    Me.Range("A4:E4").ClearContents
  End If
End Sub

Gruß Uwe

[Liunil]

Mega. Coole Idee mit der MessageBox.

Funktioniert super.

Vielen Dank dir

Dann werde ich dieses Thema jetzt schließen

[{Boris}]

Coole Idee mit der MassageBox.

Wirklich ein gute Idee - hab Rücken

[Liunil]

 

[Liunil]

Moin nochmal,

hätte gerne noch eine Erweiterung zu dem VBA:

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")
    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")
      End With
    End If
    Me.Range("A5:F5").ClearContents
  End If
End Sub


Und zwar möchte ich, dass die Tabelle, wo die Daten hinkopiert wurden, noch automtisch nach Datum absteigend sortiert wird. Dafür habe ich zwar ein VBA in den entsprechenden Tabellen, dieser wird aber irgendwie nicht automatisch ausgeführt. Wenn ich diesen manuell starte, sortiert er. Aber es soll halt automatisch passieren, nachdem ein neuer Eintrag hinzugefügt worden ist. Hier mal der sortier VBA in den einzelnen Tabellen:

Sub SortierenDatumAuf()
Worksheets("Rechnungen").Range("A4:F1000").Sort Key1:=Worksheets("Rechnungen").Range("A4"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub


Lässt sich da was "clever" lösen?

Danke schonmal im vorraus

[schauan]

Hallöchen,

Dafür habe ich zwar ein VBA in den entsprechenden Tabellen

dann starte es am Ende vom Click-Makro, indem Du dort den Namen einfügst.