Daten in VBA Schleife aus einer anderen Tabelle kopieren
06.01.2020 16:58:06
Yuyu
Nachdem ich jetzt lange Zeit vergebens versucht habe ein funktionierendes Makro zu bauen, wende ich mich nun an euch. Folgendes ist die Situation:
Ich habe in der Zeile 18 eine Zelle mit Formel, welche anhand eines vierstelligen Firmencodes verfügbare Produkte aufzählt. Diese Formel arbeitet über die Textjoin Funktion, z.B. wenn der Firmencode in Zelle B8 0001 ist, dann steht in Zelle D18 "Verfügbare Produkte: 0009 Schrauben, 0110 Muttern, 0200 Nägel". Diese Zelle bildet sich aus verfügbaren Produkten in einer anderen Tabelle.
Soweit funktioniert alles. Leider gibt es über 100 dieser Firmencodes und ich möchte ungerne alles manuell kopieren und einfügen.
Die Firmencodes befinden sich in einer Tabelle namens "EU" und beginnen in der Zelle A2. Der Firmencode steht in der Tabelle "Final" in Zelle B8.
Der zu kopierende Inhalt befindet sich in den Zeilen 14 bis 18.
Der untenstehende Code schafft es nun die Zelle A3 in B8 zu kopieren und dieses auch unendlich zu wiederholen, springt aber dann nicht weiter zur Zelle A4, A5 und so weiter.
Vielleicht kann ja jemand hier helfen...
Vielen Dank!!
Sub CopyPaste()
Dim WSQuelle As Worksheet
Dim WSZiel As Worksheet
Dim lZeile As Long
Set WSQuelle = ThisWorkbook.Worksheets("EU")
Set WSZiel = ThisWorkbook.Worksheets("Final")
For lZeile = 1 To WSZiel.Cells(Rows.Count, 1).End(xlUp).Row
If WSQuelle.Range("A" & lZeile).Value "" Then
WSZiel.Range("B8") = WSQuelle.Range("A3").Value
Rows("14:18").Select
Selection.Copy
Rows("19:19").Select
Selection.Insert Shift:=xlDown
Rows("20:23").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next lZeile
End Sub