Microsoft Excel

Herbers Excel/VBA-Archiv

Kopierte Zeilen unter die letzte Zeile

Betrifft: Kopierte Zeilen unter die letzte Zeile von: Roger Welli
Geschrieben am: 30.10.2020 15:56:29

Guten Nachmittag
Ich habe folgenden Code der alle Zeilen der Tabelle1 Kopieren sollte, welche in der Spalte G eine 1 stehen haben. Diese sollen dann in der Tabelle2 untereinander, ohne Leerzeilen eingefügt werden. Das funktioniert aber nicht recht. Kann mir jemand den Fehler zeigen?
Danke.
Freundliche Grüsse,
Roger

Sub Zeilen_kopieren()

Dim Zeile As Long


With Sheets("Tabelle1")
   For Zeile = 1 To .Range("G65536").End(xlUp).Row
      If .Cells(Zeile, 7) > 0 Then
         .Cells(Zeile, 7).EntireRow.Copy
         If Sheets("Tabelle2").Range("A1") = "" Then
            Sheets("Tabelle2").Range("A1").PasteSpecial Paste:=xlPasteAll
         Else
            Sheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:= _
xlPasteAll
         End If
      End If
   Next 'Zeile
End With

End Sub


Betrifft: AW: Kopierte Zeilen unter die letzte Zeile
von: Werner
Geschrieben am: 30.10.2020 16:00:51

Hallo,

würde ich über den Autofilter machen.
Dazu sollten aber mehr Infos vorliegen.

-wo beginnen deine Daten (Zeile / Spalte)
-lückenloser Bereich?
-Überschriften ja/nein

Am besten kurz eine Beispielmappe machen, die im Aufbau deinem Original entspricht und dann hier hochladen.

Gruß Werner

Betrifft: AW: Kopierte Zeilen unter die letzte Zeile
von: ChrisL
Geschrieben am: 30.10.2020 16:07:57

Hi

Mit Autofilter geht es definitiv schneller.

Trotzdem hier dein Makro angepasst. Ich vermute das Problem könnte sein, dass Spalte A nicht zuverlässig einen Wert enthält. Darum die letzte Zeile anhand von Spalte G ermittelt.
Sub Zeilen_kopieren()
Dim Zeile As Long
Dim letzteZeile As Long

With Sheets("Tabelle1")
   For Zeile = 1 To .Range("G65536").End(xlUp).Row
      If .Cells(Zeile, 7) > 0 Then
         .Cells(Zeile, 7).EntireRow.Copy
         letzteZeile = Sheets("Tabelle2").Range("G65536").End(xlUp).Offset(1, 0).Row
         If Sheets("Tabelle2").Range("G1") = "" Then letzteZeile = 1
         Worksheets("Tabelle2").Rows(letzteZeile).PasteSpecial Paste:=xlPasteAll
      End If
   Next Zeile
End With
End Sub
cu
Chris

Betrifft: AW: Kopierte Zeilen unter die letzte Zeile
von: Roger Welli
Geschrieben am: 30.10.2020 16:21:56

Hallo,
Danke für eure Antworten. Die Mappe habe ich hochgeladen. Der Code von Chris funktioniert gut. Ich habe aber vergessen, dass Tabelle1 laufend erweitert wird. Das heisst, jedes mal wenn ich den Code laufen lasse, wird nochmals alles unter die letzte Zeile angehängt. Ist es möglich Tabelle2 jedes mal "neu" oder leer zu starten?
Da ich 16 Spalten habe die auf Inhalte überprüft werden sollen um dann die Zeilen zu kopieren (jeweils auf eine neue Tabelle,, weiss ich nicht ob ein Spezialfilter funktioniert?
Freundliche Grüsse,
Roger
https://www.herber.de/bbs/user/141190.xlsm

Betrifft: AW: Kopierte Zeilen unter die letzte Zeile
von: ChrisL
Geschrieben am: 30.10.2020 16:47:38

Hi

Normaler Autofilter, nicht Spezialfilter. So im Grundsatz mit dem Makrorekorder
- alter Tabelleninhalt löschen
- Autofilter setzen
- Copy/Paste

Was ich dir zudem als schnelle und Makro-freie Alternative empfehlen könnte, wäre Power-Query.

Um die Tabelle2 erst zu leeren, kannst du folgende Zeile einfügen:
Worksheets("Tabelle2").Cells.Delete

Die Beispieldatei passt übrigens nicht zum Thema.

cu
Chris

Betrifft: AW: Kopierte Zeilen unter die letzte Zeile
von: Roger Welli
Geschrieben am: 30.10.2020 17:02:46

Hallo
Ja, ich hatte die Mappe nicht abgespeichert :-)
Nun ist sie richtig.
Das funktioniert nun soweit Tip, Top. Danke
Einen schönen Abend,
Roger
https://www.herber.de/bbs/user/141191.xlsm

Betrifft: AW: Kopierte Zeilen unter die letzte Zeile
von: Werner
Geschrieben am: 31.10.2020 06:02:20

Hallo,

so:
Option Explicit

Sub Zeilen_kopieren()

Application.ScreenUpdating = False

With Worksheets("Tabelle1")
    If WorksheetFunction.CountIf(.Columns("G"), 1) > 0 Then
        Worksheets("Tabelle2").Cells.ClearContents
        .Range(.Cells(1, "B"), .Cells(1, "V")).AutoFilter field:=6, Criteria1:=1
        With .AutoFilter.Range
            .Offset(1).Resize(.Rows.Count - 1).Copy
        End With
        Worksheets("Tabelle2").Range("B1").PasteSpecial Paste:=xlPasteValues
        .Range("B1").AutoFilter
    End If
End With
    
Application.CutCopyMode = False
End Sub
Gruß Werner

Beiträge aus dem Excel-Forum zum Thema "Kopierte Zeilen unter die letzte Zeile"