VBA Untuk Gabungin Metadata dan Halaman dari export python - habibmarzuqi/Atom GitHub Wiki

Klik Edit untuk kopi ke excel vba

`Sub CopyDataFromSheet1ToSheet2()

Dim LastRow1 As Long, LastRow2 As Long Dim i As Long, j As Long, InsertPos As Long Dim ws1 As Worksheet, ws2 As Worksheet Dim Found As Boolean

' Define the worksheets Set ws1 = ThisWorkbook.Sheets("final2") Set ws2 = ThisWorkbook.Sheets("metadata")

' Find the last row of Sheet1 and Sheet2 LastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

' Loop through each row in Sheet1 For i = 2 To LastRow1 Found = False ' Check if the number in Sheet1 exists in Sheet2 For j = 2 To LastRow2 If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value Then Found = True ' Find the position to insert InsertPos = j While ws2.Cells(InsertPos + 1, 1).Value = ws1.Cells(i, 1).Value And Not IsEmpty(ws2.Cells(InsertPos + 1, 1).Value) InsertPos = InsertPos + 1 Wend Exit For End If Next j

' If not found, set InsertPos to LastRow2
If Not Found Then
    InsertPos = LastRow2
End If

' Insert a new row and copy the data
ws2.Cells(InsertPos + 1, 1).EntireRow.Insert
ws2.Cells(InsertPos + 1, 1).Value = ws1.Cells(i, 1).Value
ws2.Cells(InsertPos + 1, 5).Value = ws1.Cells(i, 2).Value 'copy dari ws1 kolom2 ke dua kolom 5
ws2.Cells(InsertPos + 1, 7).Value = ws1.Cells(i, 3).Value 'copy dari ws1 kolom3 ke kolom 7

' Update the last row of Sheet2
LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

Next i End Sub `

Sheet Final2

Sheet Metadata