Transform table to list

[Hyakkivn]

Greeting everyone
I have a workbook like in picture below.
I work on 4 sheets "KT","Train_Station", "VD" and "Port" (the sheet VD, Port and Train_Station have same structure)
The row in yellow is each day on Month. I would like some help on VBA that work like:
At sheet("Port"): For each cell in day 1, if cell value = 1, then copy the staff ID to Sheet("KT") at range E2; then at range B2 of KT write the date, and at J2 write the full date. And loop til the end of month

Sub transform()
Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, cel As Range ' ... n31 as Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("KT")
Set ws2 = Worksheets("Port")
Set n1 = ws2.Range("D5:D" & Cells(Rows.Count).End(xlUp).Row) ' and n2, n3, ...n31 all day in month
For Each cel In n1
If cel = 1 Then
cel.Offset(, -1).Copy 'with n2 cel.offset(,-2) ; n3 cel.offset(,-3)...
ws1.Range("E2").Select
ActiveCell.PasteSpecial xlPasteValues
Range("B2") = 1 '1 is the 1st day of month
End If
Next
End Sub

Thanks for any help

 

[Hyakkivn]

?

 

[Hyakkivn]

+1

 

[RoryA]

Please don't keep bumping your post that often. You're actually reducing the chances of it being seen, since many of the regular posters start by looking at questions with no replies.