Zellen kopieren, leider

[matthias wehrli]

Der Laie verzweifelt mal wieder...

Ich möchte aus einer Sortimentsliste eine Einkaufsliste erstellen. 
In der Sortimentsliste kann man Mengenangaben machen. Wenn diese <>"" ist, dann soll die Zeile in eine zweite Tabelle überschrieben werden. Im Anhang mein kläglicher Versuch (mein Spezialgebiet liegt leider nicht in VBS) der gesamten Datei, hier mal nur der Code.

Mein Problem liegt leider im Kopieren der nicht leeren Zellen (Spalte B-D) in die andere Tabelle. Kann mir da jemand unter die Arme greifen?

Code:

Sub Abfrage()
Dim Bereich As Range
Dim Zelle As Range
Dim i As Integer
Set Bereich = Worksheets("Sortiment").Range("C2:C200")
For Each Zelle In Bereich
If Zelle.Value <> "" Then
' Zelle.EntireRow.Font.Color = 3333333 ' färbt Einkäufe farbig
' Kopiere Zellen B-D des Worksheets Sortiment in Zellen B-D des Worksheets Einkaufsliste.
' Beginne in Zeile 2 (i=2)
' erhöhe i um 1, damit der nächste Eintrag in der nächsten Zeile steht.
End If
Next Zelle
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Einkauf.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub

Ich danke allen Lesern, noch mehr allen die nicht lachen oder meckern und am meisten denen die helfen ;)
LG
Matthias

[Kuwer]

Hallo Matthias,

so z.B.:

Code:

Sub Abfrage()
  With Worksheets("Sortiment")
    Intersect(.Range("B2:D200"), .Range("C2:C200").SpecialCells(xlCellTypeConstants).EntireRow).Copy
  End With
  With Worksheets("Einkaufsliste")
    .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)) = ""
    .Paste .Cells(2, 1)
    .ExportAsFixedFormat Type:=xlTypePDF, _
                         Filename:="C:\Einkauf.pdf", _
                         Quality:=xlQualityStandard, _
                         IncludeDocProperties:=True, _
                         IgnorePrintAreas:=False, _
                         OpenAfterPublish:=True
  End With
End Sub

Gruß, Uwe

[steve1da]

Hola,
ist das nicht die gleiche Frage wie hier?
https://www.clever-excel-forum.de/Thread...re-Tabelle
Gruß,
steve1da

[schauan]

@matthias,

Du kannst Deine Beiträge innerhalb 60 Minuten ändern. Alternativ kannst Du auch auf Deine Beiträge antworten, wenn Du etwas ergänzen oder besser beschreiben willst (oder warum auch immer )

[Cadmus]

Hi,

warum nutzt du nicht die Filter-Funktion?

=FILTER(Sortiment!B2:D14;Sortiment!C2:C14<>"")

[matthias wehrli]

Vielen Dank für die kurze Lösung... man sieht mal wieder, ich muss noch viiiiiiiel lernen (da hab ich sicher einige "i" zuwenig geschrieben.