Office: [Excel2013] Zellen in andere Tabelle kopieren

Ich weiß, dass ist ein oft angefragtes Thema. Habe da auch schon etwas gebastelt, aber hänge gerade etwas. Hab mich mal versucht in VBA einzulesen, aber da gibt es ja so viele Möglichkeiten, dass ich da noch eine Weile brauchen werde:

Ich habe in Blatt 1 in den Spalten A-C Daten stehen. Diese sollen nach Markierung in Spalte D in Blatt2 kopiert werden. Idealzustand wäre, bspw. Zeile 2 und 4 sind markiert (für den Anfang mit "x" geplant mit Datum), diese sollen in Blatt zwei verschoben werden (also auch gelöscht- aber eben nicht die gesamte Zeile, da ab Spalte F andere Daten stehen) und die darunter liegenden Daten aus Spalte A-D sollen hoch rutschen. Zeile entfernen geht halt nicht, weil ab Spalte F andere Sachen stehen. Weiterer Plan wäre, entsprechend des Datums sollen dann automatisch die Daten in ein entsprechendes Monatsblatt (also Januar, Februar etc.)

Derzeit bin ich gerade am tüfteln mit kopieren. Mein Problem nämlich, an welchem es gerade scheitert ist, dass immer nur die letzte markierte Zeile kopiert wird. Also Zeile 1,2 und 4 ist markiert- und Zeile 4 wird nur kopiert. Ich hatte mal ne Messagebox eingefügt, um zu überprüfen, ob er auch alle markierten Zellen erkennt - das klappt. Aber er kopiert dann die Daten trotzdem nicht...

In der angehängten Datei befindet sich das Makro in Modul 1 und unter "Tabelle1" ein Button mit dem Makro-Aufruf...


Gut habe es soweit hinbekommen. Das Makro lautet:

Ist zwar alles noch etwas unsortiert, aber das liegt an den verschiedenen Versuchen. Wird noch aufgeräumt...

 

Hi,

ich würde es so lösen:

Code:

Sub kopieren()
    Dim lngErste As Long
    Dim lngZeile As Long
    Dim lngLetzte As Long
    ' Code nur ausführen wenn mindestes 1 Wert in Spalte D steht
    If Application.CountA(Columns(4)) > 0 Then
        lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
        With Worksheets("Tabelle2")
            ' erste freie Zeile ermitteln
            If Application.CountA(.Columns(1)) = 0 Then
                lngErste = 1
            Else
                lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
                    .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
            End If
            ' Schleife über alle Zeilen von 1 bis zu letzten belegten in Spalte A
            For lngZeile = 1 To lngLetzte
                ' Spalre D enthält einen Eintrag
                If Cells(lngZeile, 4) <> "" Then
                    ' Spalten A:D der leaufenden Zeile in erste freie Zeile kopieren
                    Range(Cells(lngZeile, 1), Cells(lngZeile, 4)).Copy .Cells(lngErste, 1)
                    ' Spalte A laufende Zeile leeren
                    Range(Cells(lngZeile, 1), Cells(lngZeile, 4)).ClearContents
                    lngErste = lngErste + 1
                End If
            Next lngZeile
        End With
        ' Spalten A:D der geleerten Zeilen löschen
        Range(Cells(1, 1), Cells(lngLetzte, 4)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    End If
End Sub

Bis später,
Karin

 

Oh, habe vielen Dank. Klappt super. Konnte mich bisher nicht weiter damit beschäftigen. Jetzt bin ich dabei das ganze mal zu entschlüsseln, damit ich die Sachen abhängig vom Datum in das jeweilige Tabellenblatt (Januar, Februar etc.) kopieren kann...


//Edit:

So, habe mich mal damit auseinandergesetzt. Da, wie ich das rausgelesen habe, das ganze nur mit einer Tabelle funktioniert, habe ich mal mein Makro hergenommen und das mit deinem verknüpft. Hat mir halt geholfen auch alles etwas besser zu verstehen. Ich liste mal hier mein Makro auf - mit Dokumentation dahinter. Vielleicht kann ja mal jemand sagen, ob das soweit ganz clever ist oder ob man da noch was optimieren kann...
In der angehängten Mappe ist halt das ganze als Beispiel ersichtlich. Falls es ok ist, kann es ja dann jeder der sowas mal braucht auch verwenden...