☰

VBA: 새 행을 만들고 다른 시트의 데이터로 자동 채우기

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2016
VBA: 새 행을 만들고 다른 시트의 데이터로 자동 채우기

아래 정보가 포함된 시트 2개가 있습니다.

시트B
항목1
항목2

시트C
위치A
위치B
위치C

그리고 SheetA에서 아래 결과를 얻으려고 합니다.

시트A
항목1 위치A
항목1 위치
B 항목
1 위치C 항목2
위치A 항목2 위치
B 항목2 위치C

이 vba 코드를 사용하여 SheetB에서 SheetA로 항목을 복사하지만 각 항목은 서로 다른 위치에 저장될 수 있으므로 SheetB의 각 항목과 SheetC에 나열된 가능한 모든 위치를 SheetA에 나열하고 싶습니다. 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

관련 정보