Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1788to1792
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopierte Zeilen unter die letzte Zeile

Kopierte Zeilen unter die letzte Zeile
30.10.2020 15:56:29
Roger
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopierte Zeilen unter die letzte Zeile
30.10.2020 16:00:51
Werner
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
AW: Kopierte Zeilen unter die letzte Zeile
30.10.2020 16:07:57
ChrisL
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
Anzeige
AW: Kopierte Zeilen unter die letzte Zeile
30.10.2020 16:21:56
Roger
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
Anzeige
AW: Kopierte Zeilen unter die letzte Zeile
30.10.2020 16:47:38
ChrisL
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
AW: Kopierte Zeilen unter die letzte Zeile
30.10.2020 17:02:46
Roger
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
Anzeige
AW: Kopierte Zeilen unter die letzte Zeile
31.10.2020 06:02:20
Werner
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige