Excel VBA - Loop to next available blank cell - vba

Question

I am attempting to write a small section of code to create a new worksheet and insert values from a table in a source worksheet starting at row 2, column 1 thru column 4. Once it reaches the end, I need it to loop to the next row and start over.
The issue I have is that the below code loops back to row 1 of the new worksheet and data is overridden. Is there a simple way to have my loop start on the first blank row down?
[2
Sub SAX()
Dim wsSource As Excel.Worksheet, wsData As Excel.Worksheet
Dim r As Long, c As Long
Set wsData = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsData.Name = "Data"
Set wsSource = ThisWorkbook.Worksheets("Header")
Application.DisplayAlerts = False
r = 2
Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
For c = 1 To 4
wsData.Cells(c * 1, 1).Value = wsSource.Cells(r, c).Value
Next c
ThisWorkbook.Activate
r = r + 1
Loop
Application.DisplayAlerts = True
End Sub

Answer 1

What you want is this, assuming (from screenshot) that you're working with a structured ListObject table:
Sub SAX()
Dim wsSource As Excel.Worksheet, wsData As Excel.Worksheet
Dim i as Long
Dim tbl As ListObject
Dim vals As Variant
With ThisWorkbook
Set wsData = Sheets.Add(After:=.Sheets(.Sheets.Count))
Set wsSource = .Worksheets("Header")
End With
wsData.Name = "Data"
'## Get a handle on the Table object
Set tbl = wsSource.ListObjects(1) 'Modify if needed
Application.DisplayAlerts = False
i = 1 'which row we start putting data on wsData
'## Iterate each row of data in the Table
For Each rng In tbl.DataBodyRange.Rows
'## Dump this row's values in to an array, and transpose it
vals = Application.Transpose(rng.Value)
'## Put the array's values in an appropriately sized range on the wsData sheet:
wsData.Cells(i, 1).Resize(UBound(vals)).Value = vals
'## Increment the destination row number:
i = i + UBound(vals)
Next
Application.DisplayAlerts = True
End Sub
Here we transpose the rng.Value so that we can drop it in a column. We store this in the vals array. We then use the vals array to determine the size of the range where the values will be placed on "Data" sheet, and also use the size of the vals array to increment our i variable, which tells us where to put the next row's data.
Or, maybe even more simply:
For i = 1 to tbl.DataBodyRange.Cells.Count
wsData.Cells(i, 1).Value = tbl.DataBodyRange.Cells(i).Value
Next
This works because a range is indexed by row/column, so we begin counting cell #1 at the top/left, and then wrap to the second row and resume counting, for example, the "cell index" is in this example table:
This can easily be put into a single row or column, just by iterating over the Cells.Count!

Answer 2

Try this...you actually need two Row values, one for data, one for output:
Sub SAX()
Dim wsSource As Worksheet, wsData As Worksheet
Dim lDataRow As Long, lCol As Long, lOut as Long
Set wsData = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsData.Name = "Data"
Set wsSource = ThisWorkbook.Worksheets("Header")
Application.DisplayAlerts = False
lDataRow = 2
lOut = 1
Do
For lCol = 1 To 4
wsData.Cells(lOut, 1) = wsSource.Cells(lDataRow, lCol)
Next lCol
lDataRow = lDataRow + 1
lOut = lOut + 1
Loop Until Len(Trim(wsSource.Cells(lDataRow, 1))) = 0
Application.DisplayAlerts = True
End Sub

Answer 3

It would be more efficient to create an array and write all the data at one time.
Sub SAX()
Dim Data, v
Dim x As Long, y As Long
With ThisWorkbook.Worksheets("Header")
With .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
x = WorksheetFunction.RoundUp(.Cells.Count / 4, 0)
ReDim Data(1 To x, 1 To 4)
x = 1
For Each v In .Cells
If y = 4 Then
x = x + 1
y = 1
Else
y = y + 1
End If
Data(x, y) = v
Next
End With
End With
With ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
.Name = "Data"
.Range("A1:D1") = Array(1, 2, 3, 4)
.Range("A2:D2").Resize(UBound(Data, 1)).Value = Data
End With
End Sub