VBA: cree nuevas filas y complételas automáticamente con datos de diferentes hojas

Question

Tengo 2 hojas con la siguiente información:

HojaB
Artículo 1
Artículo 2

HojaC
UbicaciónA
UbicaciónB
UbicaciónC

Y estoy tratando de obtener el siguiente resultado en la HojaA:

HojaA
Artículo1 UbicaciónA
Artículo1 UbicaciónB
Artículo1 UbicaciónC
Artículo2 UbicaciónA
Artículo2 UbicaciónB
Artículo2 UbicaciónC

Utilizo este código vba para copiar los elementos de la Hoja B a la Hoja A, pero cada elemento se puede almacenar en diferentes ubicaciones, por lo que me gustaría haber enumerado en la Hoja A cada elemento de la Hoja B y todas las ubicaciones posibles que se enumeran en la Hoja C. La idea de SheetA es tener un resumen con toda la información.

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

Gracias.

Answer 1

Esta es la solución que encontré:

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