View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Assistance in transposing multiple sets of data

Hi Mark,

Am Thu, 10 Aug 2017 05:01:07 -0700 (PDT) schrieb Living the Dream:

Required Format: ( Sheet 2 )

_____A________B________C_______D_________E________ _F__________G_______________
1___Date_____Unit____HrsTot__HrsIdle__HrsActive___ Loads____Rev/Cost___________
2__26/6/17___C001____15.25_____0_______15.25_______6______ ___0.00_____________
3__26/6/17___C002_____0.00_____0________0.00_______0______ ___0.00_____________
4__Etc.....


I don't know if I understood your table layout correctly.
Try:

Sub TransposeTable()
Dim rng1 As Range, rng2 As Range
Dim i As Integer, rowsC1 As Integer, rowsC2 As Integer
Dim Lrow As Long, j As Long

With Sheets("Sheet1")
Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For j = 9 To Lrow Step 48
For i = 1 To 31 Step 6
Set rng1 = .Range(.Cells(j, i), .Cells(j + 13, i + 5))
Set rng2 = .Range(.Cells(j + 18, i), .Cells(j + 37, i + 5))
rowsC1 = rng1.Rows.Count
rowsC2 = rng2.Rows.Count
Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)(2) _
.Resize(rowsC1, 6).Value = rng1.Value
Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)(2) _
.Resize(rowsC2, 6).Value = rng2.Value
Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)(2) _
.Resize(rowsC1 + rowsC2) = .Cells(j - 2, i)
Next
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016