☰

VBA: создание новых строк и автоматическое заполнение их данными из разных листов

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2016
VBA: создание новых строк и автоматическое заполнение их данными из разных листов

У меня есть 2 листа со следующей информацией:

ЛистБ
Пункт1
Пункт2

ЛистC
МестоположениеA
МестоположениеB
МестоположениеC

И я пытаюсь получить следующий результат в SheetA:

ЛистА
Пункт 1 МестоположениеA
Пункт 1 МестоположениеB Пункт 1
МестоположениеC Пункт 2 МестоположениеA Пункт 2 МестоположениеB Пункт 2 МестоположениеC



Я использую этот код vba для копирования элементов из SheetB в SheetA, но каждый элемент может храниться в разных местах, поэтому я хотел бы перечислить в SheetA каждый элемент из SheetB и все возможные места, которые перечислены в SheetC. Идея SheetA заключается в том, чтобы иметь сводку со всей информацией.

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

Спасибо.

решение1

Вот решение, которое я нашел:

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

Связанный контент