Sub TransferData()
Dim tbl1 As ListObject, tbl2 As ListObject, Card As Worksheet
Set tbl1 = ThisWorkbook.Worksheets("Table").ListObjects("Table1")
Set tbl2 = ThisWorkbook.Worksheets("Menu").ListObjects("Table2")
Set Card = ThisWorkbook.Worksheets("Card")
If tbl2.DataBodyRange Is Nothing Then Exit Sub

Dim NewRow As ListRow
tbl1.ListRows.Add
Set NewRow = tbl1.ListRows(tbl1.ListRows.Count)
NewRow.Range.Cells(tbl1.ListColumns("Kode").Index).Resize(tbl2.ListRows.Count, tbl2.ListColumns.Count).Value = tbl2.DataBodyRange.Value

'build card
Dim LastRow As Long, Rw As Long, Col As Long
On Error Resume Next
LastRow = Card.Cells.Find("*", Card.Cells(1), , , xlByRows, xlPrevious).Row
If Err.Number <> 0 Then LastRow = 0
On Error GoTo 0

Card.Columns(1).ColumnWidth = 1
Card.Columns(2).ColumnWidth = 35
Card.Columns(3).ColumnWidth = 1
Card.Columns(4).ColumnWidth = 35
Card.Columns(5).ColumnWidth = 1
Card.Columns(6).ColumnWidth = 35

'identify first empty column
Col = 2

If LastRow > 0 Then
If Len(Card.Cells(LastRow, 6).Value) = 0 Then Col = 6
If Len(Card.Cells(LastRow, 4).Value) = 0 Then Col = 4
If Col > 2 Then LastRow = LastRow - 7
End If

Dim i As Long
For i = 1 To tbl2.ListRows.Count
DoEvents
Card.Cells(LastRow + 1, 1).RowHeight = 8

Card.Cells(LastRow + 2, Col).Value = "Green Officer"
Card.Cells(LastRow + 3, Col).Value = tbl2.ListRows(i).Range.Cells(tbl2.ListColumns("Kode").Index).Value
Card.Cells(LastRow + 4, Col).Value = "Green Fruits"
Card.Cells(LastRow + 5, Col).Value = "name: " & tbl2.ListRows(i).Range.Cells(tbl2.ListColumns("Name").Index).Value
Card.Cells(LastRow + 6, Col).Value = "Room: " & tbl2.ListRows(i).Range.Cells(tbl2.ListColumns("Room").Index).Value
Card.Cells(LastRow + 7, Col).Value = "Pembelian/ Hibah: " & tbl2.ListRows(i).Range.Cells(tbl2.ListColumns("Pembelian").Index).Value

FormatRange Card.Range(Card.Cells(LastRow + 2, Col), Card.Cells(LastRow + 3, Col))
FormatRange Card.Range(Card.Cells(LastRow + 4, Col), Card.Cells(LastRow + 7, Col))

Dim Img As Shape, ImgCopy As Shape
Set Img = tbl2.Parent.Shapes("Green Fruits")
Img.Copy
Card.Cells(LastRow + 2, 2).PasteSpecial
Set ImgCopy = Card.Shapes(Card.Shapes.Count)
ImgCopy.Top = Card.Cells(LastRow + 2, Col).Top + 2
ImgCopy.Left = Card.Cells(LastRow + 2, Col).Left + 4

Col = Col + 2
If Col > 6 Then 'move to a new row
Col = 2
LastRow = LastRow + 7
End If

Next i
Application.Goto Card.Cells(LastRow + 2, Col)
tbl2.DataBodyRange.Delete

End Sub

Sub FormatRange(ByVal Rng As Range)

With Rng
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlMedium
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

End Sub