my goal is to copy cells in a dynamic range from Column B to S to another sheet if they are non zero. Additionally, would like to move the cells up to the top of the next sheet (Without having to clear blank rows each time). Have the code working for 1 column (when Col was replaced with "B", "C", etc.) but when I tried to make it a for loop of multiple it doesnt work.
Any help would be appreciated!
Sub MoveFormulaDataLooped()
Dim ws1 As Worksheet: Set ws1 = Worksheets("Fancy Wall")
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet1")
Dim VeryLastRow As Integer: VeryLastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
Dim i As Integer
Dim Col As Integer
For i = 2 To VeryLastRow
For Col = 2 To 19
If ws1.Range(Col & i) > 0 Then
ws2.Range(Col & i) = ws1.Range(Col & i)
Next
Next
End Sub
CodePudding user response:
A few notes:
- You are looking for the property
.Cells
instead of.Range
, as it uses row and column index to access your range. - You are missing an
End If
in you most inner conditional - You need to capture the next row for your
ws2
so that you don't have blanks between them
I included a function that helps you find the next available row, and made the fixes from my notes above.
' Finds the next empty row on a worksheet.
Public Function NextAvailibleRow(ByRef ws As Worksheet) As Range
On Error GoTo catch
Set NextAvailibleRow = ws.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Offset(1).EntireRow
Exit Function
' If there is an error, that means the worksheet is empty.
' Return the first row
catch:
Set NextAvailibleRow = ws.Rows(1)
End Function
Sub MoveFormulaDataLooped()
Dim ws1 As Worksheet: Set ws1 = Worksheets("Fancy Wall")
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet1")
Dim VeryLastRow As Integer
VeryLastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
Dim i As Integer
For i = 2 To VeryLastRow
' Need to capture the next row for Sheet1
Dim nextSheet1Row As Long
nextSheet1Row = NextAvailibleRow(ws2).Row
Dim Col As Integer
For Col = 2 To 19
If ws1.Cells(i, Col) > 0 Then
' Use `.Cells`
ws2.Cells(nextSheet1Row, Col) = ws1.Cells(i, Col)
End If ' Was missing
Next
Next
End Sub