Frage von kandi16, 265

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

Ich versuche vergeblich ein Makro für eine Exceltabelle zu erstellen und brauche dringend Hilfe. In der Tabelle1 befindet sich eine Liste mit 1200 Artikeln. In der Spalte A sind die Artikelnummern und in den Spalten C bis N die Stückzahl zu dem jeweiligen Artikel.

Durch ein Makro will ich nur die Zeilen in die Tabelle2 kopieren, bei denen ein Wert/Stückzahl zu dem jeweiligen Artikel in die Spalten C bis N eingetragen wurde.

Ich hoffe mir kann jemand weiterhelfen.... Vielen Dank

Expertenantwort
von Iamiam, Community-Experte für Excel, 219

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.

Antwort
von PWolff, 167
'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)
Expertenantwort
von Suboptimierer, Community-Experte für Excel, 172

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
Kommentar von Suboptimierer ,

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

If WorksheetFunction.CountIf(Range("C" & i & ":N" & i), ">0") > 0 Then

Keine passende Antwort gefunden?

Fragen Sie die Community

Weitere Fragen mit Antworten