Copying over certain cells from multiple columns

user_14700989 0
Viewed 30

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
paste copy vba excel
1 Answers

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
user_83096430
Related