VBA: Neue Zeilen erstellen und automatisch mit Daten aus verschiedenen Blättern füllen

Question

Ich habe 2 Blätter mit den folgenden Informationen:

BlattB
Artikel1
Artikel2

BlattC
StandortA
StandortB
StandortC

Und ich versuche, das folgende Ergebnis in SheetA zu erhalten:

BlattA
Artikel1 StandortA
Artikel1 StandortB
Artikel1 StandortC
Artikel2 StandortA
Artikel2 StandortB
Artikel2 StandortC

Ich verwende diesen VBA-Code, um die Elemente von Blatt B nach Blatt A zu kopieren, aber jedes Element kann an einem anderen Ort gespeichert werden. Daher möchte ich in Blatt A jedes Element aus Blatt B und alle möglichen Orte aufgelistet haben, die in Blatt C aufgelistet sind. Die Idee von Blatt A besteht darin, eine Zusammenfassung mit allen Informationen zu haben.

Worksheets("SheetB").ListObjects("ArtikelDBTable").ListColumns("ARTIKEL").DataBodyRange.Copy _
Destination:=Worksheets("SheetA").ListObjects("WerbemittelTable").ListColumns("ARTIKEL").DataBodyRange

Danke.

Answer 1

Dies ist die Lösung, die ich gefunden habe:

Sub Makro1()

    Dim i As Long
    Dim ii As Long
    Dim i3 As Long
    Dim i4 As Long
    Dim LastRowSht2 As Long
    Dim LastRowSht3 As Long
    Dim wb As Workbook
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet

    Set wb = ThisWorkbook
    Set sht1 = wb.Sheets("Tabelle1")
    Set sht2 = wb.Sheets("Tabelle2")
    Set sht3 = wb.Sheets("Tabelle3")

    'Find the last row (in column A) with data.
    LastRowSht2 = sht2.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
    LastRowSht3 = sht3.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
    ii = 2
    i4 = 2

    For i = 2 To LastRowSht2

        For i3 = 2 To LastRowSht3
            sht1.Range("A" & ii) = sht2.Range("A" & i).Value
            sht1.Range("B" & ii) = sht3.Range("A" & i4).Value
            ii = ii + 1
            i4 = i4 + 1
        Next i3
        i4 = 2
    Next i
 End Sub