Copy the date vertical to horizontal using macro

[webmax]

Hi
I want the macro to copy the attached sample date to horizontal

I attaching the input file and output file too. kindly do the needful.

regards
Shahul

 

[Hui]

I would use the following formulas

Output!A2: =OFFSET(Input!A$1,ROWS(Input!J$2:Input!J2)-4*INT((ROWS(Input!J$2:Input!J2)-0.1)/4),0)
Output!B2: =OFFSET(Input!B$1,ROWS(Input!K$2:Input!K2)-4*INT((ROWS(Input!K$2:Input!K2)-0.1)/4),0)
Output!C2: =OFFSET(Input!C$1,ROWS(Input!L$2:Input!L2)-4*INT((ROWS(Input!L$2:Input!L2)-0.1)/4),INT((ROWS(Input!J$2:Input!J2)-0.1)/4))
Output!D2: =OFFSET(Input!C$1,0,INT((ROWS(Input!J$2:Input!J2)-0.1)/4))
Copy row 2 down

 

[webmax]

sir

i want this in the macro

 

[Hui]

Sub Due_Date()

Dim myArray() As Variant
Dim lastRopw As Integer
Dim lastCol As Integer

With Worksheets("Input")
  lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

Worksheets("Input").Select
myArray = Range("A1").CurrentRegion

Worksheets("Output").Select
With Sheets("Output")
  .Cells(1, 1) = "Sl. No."
  .Cells(1, 2) = "Name Of The Customer"
  .Cells(1, 3) = "Due Date"
  .Cells(1, 4) = "Remarks"

  For j = 3 To lastCol
  For i = 2 To lastRow
  .Cells((j - 3) * 4 + i, 1) = myArray(i, 1)
  .Cells((j - 3) * 4 + i, 2) = myArray(i, 2)
  .Cells((j - 3) * 4 + i, 3) = myArray(i, 3)
  .Cells((j - 3) * 4 + i, 4) = myArray(1, j)
  Next i
  Next j

End With

With Range("A1").CurrentRegion
  .Borders(xlDiagonalDown).LineStyle = xlNone
  .Borders(xlDiagonalUp).LineStyle = xlNone
  .Borders(xlEdgeLeft).LineStyle = xlNone
  .Borders(xlEdgeTop).LineStyle = xlNone
  .Borders(xlEdgeBottom).LineStyle = xlNone
  .Borders(xlEdgeRight).LineStyle = xlNone
  .Borders(xlInsideVertical).LineStyle = xlNone
  .Borders(xlInsideHorizontal).LineStyle = xlNone
End With

With Range("A1").CurrentRegion
  With .Borders(xlEdgeLeft)
  .LineStyle = xlContinuous
  .ColorIndex = 0
  .TintAndShade = 0
  .Weight = xlThin
  End With
  With .Borders(xlEdgeTop)
  .LineStyle = xlContinuous
  .ColorIndex = 0
  .TintAndShade = 0
  .Weight = xlThin
  End With
  With .Borders(xlEdgeBottom)
  .LineStyle = xlContinuous
  .ColorIndex = 0
  .TintAndShade = 0
  .Weight = xlThin
  End With
  With .Borders(xlEdgeRight)
  .LineStyle = xlContinuous
  .ColorIndex = 0
  .TintAndShade = 0
  .Weight = xlThin
  End With
  With .Borders(xlInsideVertical)
  .LineStyle = xlContinuous
  .ColorIndex = 0
  .TintAndShade = 0
  .Weight = xlThin
  End With
  With .Borders(xlInsideHorizontal)
  .LineStyle = xlContinuous
  .ColorIndex = 0
  .TintAndShade = 0
  .Weight = xlThin
  End With
End With

End Sub

or see attached file