AW: nur gefüllte Zellen kopieren
08.04.2006 07:47:45
Erich
Hi Carola,
nur nicht gleich verzweifeln!
Die Aufgabe stellte sich nach dem Download der Mappe doch etwas anders dar. Eine, wenn nicht die Ursache des Problems waren die verbundenen Zellen. Damit handelt man sich leicht eine Menge Zusatzarbeit ein. Ich habe diese Zellen deshalb wieder aufgeteilt. Damit sollte es nun gehen:
Option Explicit
Sub kopieren()
Dim zQ&, zZ&
Sheets("Rechnungen Gesamt").Activate
With Sheets("Rechnung") ' Quelltabelle
zZ = Cells(Rows.Count, 2).End(xlUp).Row ' letzte Zeile Zieltabelle
For zQ = 23 To 37
If Not IsEmpty(.Cells(zQ, 2)) Then
zZ = zZ + 1
Cells(zZ, 1) = .Cells(18, 8) ' Datum
Cells(zZ, 2) = .Cells(zQ, 2) ' Artikel
Cells(zZ, 3) = .Cells(zQ, 3) ' Bezeichnung
Cells(zZ, 4) = .Cells(zQ, 4) ' Gebinde
Cells(zZ, 5) = .Cells(zQ, 5) ' Menge
Cells(zZ, 6) = .Cells(zQ, 7) ' Preis/Einh
Cells(zZ, 7) = .Cells(zQ, 8) ' Gesamt
Cells(zZ, 8) = .Cells(13, 7) ' Kd-Nr
Cells(zZ, 9) = .Cells(13, 3) ' Name
Cells(zZ, 10) = .Cells(15, 7) ' Kd-Nr
End If
Next zQ
Cells(zZ + 1, 1).Select 'nicht nötig, aber vielleicht gewünscht
End With
End Sub
Damit die Prozedur und die Tabellen zusammen passen, lade ich die neue Mappe auch mal hoch:
https://www.herber.de/bbs/user/32705.xls
Viel Spaß!
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort