Durch ein VBA Makro nur Zeilen mit Inhalt in eine neue Tabelle kopieren?

...komplette Frage anzeigen

3 Antworten

es geht auch ganz ohne Makro(aller guten Dinge sind 8, hab Acht!):

  1. Füge davor zwei Hilfsspalten ein (werden am Ende wieder gelöscht):
  2. Schreibe in B1 die Formel: =Anzahl2(E1:P1),   in A1 =Zeile(A1)
  3. Erst in B1, dann in A1 Doppelklick aufs Ausfüllkästchen: Die Formeln werden bis zum Ende der Liste runterkopiert.
  4. Spalten A&B (NUR DIESE! am Spaltenkopf) markieren, kopieren, in A1 ALS WERTE wieder einfügen
  5. Ganzes Blatt sortieren nach Spalte B: egal, ob steigend oder fallend.
  6. Alle Zeilen mit 0 Einträgen In E:P (ursprünglich C:N) stehen jetzt zusammen und können gesammelt gelöscht werden.
  7. Ganze Tabelle nach Spalte A (steigend) sortieren: Die Einträge stehen in der alten Reihenfolge da, ohne die aussortierten.
  8. Spalten A&B löschen, fertig.

Mach das auf einer Kopie des Originalblattes, falls Du einen Fehler machst.

Wie wäre es mit einer hybriden Lösung?

Füge in Spalte O die Formel ein 

=SUMMENPRODUKT(ABS(C2:N2))>0

oder

=ZÄHLENWENN(C2:N2;">0")>0

Damit sind alle zu kopierenden Zeilen markiert. In VBA kopierst du dann mit

Sub Kopieren()
  Dim i, j As Integer
  j = 2
  For i = 2 To Range("A:A").End(xlDown).Row
    If Range("O" & i).Value Then
      Range(i & ":" & i).Copy Tabelle2.Range("A" & j)
      j = j + 1
    End If
  Next
End Sub

In VBA sähe die ZÄHLENWENN-Funktion so aus:

If WorksheetFunction.CountIf(Range("C" & i & ":N" & i), ">0") > 0 Then
0
'Quelltabelle ist das Worksheet, in dem die Daten stehen,
'Zieltabelle ist das Worksheet, in das die Daten übertragen werden sollen

Dim Quellzeile As Integer, Zielzeile As Integer

Zieltabelle.Cells.Clear 'erst mal die Zieltabelle leeren, damit keine Reste übrig bleiben
Zielzeile = 1 'Startwert zum Eintragen
For Quellzeile = 1 To Quelltabelle.Cells.SpecialCells(xlLastCell)
'Nachprüfen, ob genügend Werte eingetragen sind - mindestens einer oder alle, je nachdem
' -- hier der Code der Prüfung --
'das Ergebnis der Prüfung steht im Boolean zeileOK
If zeileOK Then
Quelltabelle.Rows(Quellzeile).Copy(Zieltabelle.Rows(Zielzeile))
Zielzeile = Zielzeile + 1
End If 'zeileOK
Next Quellzeile '= 1 To Quelltabelle.Cells.SpecialCells(xlLastCell)

Was möchtest Du wissen?