VBA: crie novas linhas e preencha-as automaticamente com dados de planilhas diferentes

Question

Tenho 2 planilhas com as informações abaixo:

Folha B
Item1
Item2

FolhaC
LocalizaçãoA
LocalizaçãoB
LocalizaçãoC

E estou tentando obter o resultado abaixo na PlanilhaA:

FolhaA
Item1 LocalizaçãoA
Item1 LocalizaçãoB
Item1 LocalizaçãoC
Item2 LocalizaçãoA
Item2 LocalizaçãoB
Item2 LocalizaçãoC

Eu uso esse código vba para copiar os itens da Planilha B para a Planilha A, mas cada item pode ser armazenado em locais diferentes, então gostaria de listar na Planilha A cada item da Planilha B e todos os locais possíveis listados na Planilha C. A ideia da SheetA é ter um resumo com todas as informações.

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

Obrigado.

Answer 1

Esta é a solução que encontrei:

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