Home Looping and Copy Data to a new sheet

# Looping and Copy Data to a new sheet

Oliver
1#
Oliver Published in 2018-02-14 16:59:35Z
 This is my first post, but I have an excel workbook with multiple tabs formatted like this: I'm learning vba but don't know the excel functions well enough yet to loop through the rows and copy the data reformatted to a new sheet into this format: Specifically I think i need to - Initialize the range of worksheets loop through them store column headers for b through G into a variable so when the x is found it can be concatenated or copied over handle the blank spaces so that the last value is used for each one Any help appreciated. Thanks!
Xabier
2#
 The following will do what you expect: Sub foo() Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'declare and set your worksheet, amend as required Dim wsResult As Worksheet: Set wsResult = Sheets("Sheet2") LastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row 'get the last row with data on Column J For i = 2 To LastRow NextRow = wsResult.Cells(wsResult.Rows.Count, "D").End(xlUp).Row + 1 ws.Range("H" & i & ":J" & i).Copy Destination:=wsResult.Range("D" & NextRow) wsResult.Range("A" & NextRow).Value = "Title" If ws.Cells(i, 1) <> "" Then 'if GroupID is not empty wsResult.Range("B" & NextRow).Value = ws.Cells(i, 1) 'grab that GroupID Else x = i Do While Trim(ws.Cells(x, 1)) = "" x = x - 1 Group = ws.Cells(x, 1) 'get the GroupID of the Row above Loop wsResult.Range("B" & NextRow).Value = Group End If For y = 2 To 7 If ws.Cells(i, y) <> "" Then Level = ws.Cells(1, y).Value Exit For End If Next y wsResult.Cells(NextRow, 3) = Level Next i End Sub 
 Try this: Sub BuildTable() Dim data(), i As Integer, j As Integer data = Worksheets("Sheet1").Range("A2:J5").Value For i = 1 To UBound(data) With Worksheets("Sheet2") .Range("A" & i) = "Title" .Range("D" & i) = data(i, 8) .Range("E" & i) = data(i, 9) .Range("F" & i) = data(i, 10) If i > 1 Then .Range("B" & i) = IIf(data(i, 1) <> "", data(i, 1), .Range("B" & i - 1)) Else .Range("B" & i) = data(i, 1) End If For j = 2 To 7 If data(i, j) = "x" Then .Range("C" & i) = "Level" & j - 1 End If Next j End With Next i End Sub