I am trying to move specific rows according to earlier formulas from one sheet to another but there is no continuity in where the cells get pasted in. I would like them to start at the top but sometimes the rows start at for exampel row A384.

Trying to use the code according to below.

Any ideas what could possible be the solution in my case?

   Dim Num As Range
    Dim xCell2 As Range
    Dim X As Long
    Dim Y As Long
    Dim Z As Long
    X = Worksheets("Test1").UsedRange.Rows.Count
    Y = Worksheets("Test2").UsedRange.Rows.Count
    If Y = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Test2").UsedRange) = 0 Then Y = 0
    End If
    Set Num = Worksheets("Test1").Range("K:K" & L)
    On Error Resume Next
    Application.ScreenUpdating = False
    For Z = 1 To Num.Count
        If CStr(Num(Z).Value) = "1" Then
            Num(Z).EntireRow.Copy Destination:=Worksheets("Test2").Range("A" & Y + 1)
            Num(Z).EntireRow.Delete
            If CStr(Num(Z).Value) = "1" Then
                Z = Z - 1
            End If
            Y = Y + 1
        End If
    Next
    Application.ScreenUpdating = True

I am trying to move specific rows according to earlier formulas from one sheet to another but there is no continuity in where the cells get pasted in. I would like them to start at the top but sometimes the rows start at for exampel row A384.

Trying to use the code according to below.

Any ideas what could possible be the solution in my case?

   Dim Num As Range
    Dim xCell2 As Range
    Dim X As Long
    Dim Y As Long
    Dim Z As Long
    X = Worksheets("Test1").UsedRange.Rows.Count
    Y = Worksheets("Test2").UsedRange.Rows.Count
    If Y = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Test2").UsedRange) = 0 Then Y = 0
    End If
    Set Num = Worksheets("Test1").Range("K:K" & L)
    On Error Resume Next
    Application.ScreenUpdating = False
    For Z = 1 To Num.Count
        If CStr(Num(Z).Value) = "1" Then
            Num(Z).EntireRow.Copy Destination:=Worksheets("Test2").Range("A" & Y + 1)
            Num(Z).EntireRow.Delete
            If CStr(Num(Z).Value) = "1" Then
                Z = Z - 1
            End If
            Y = Y + 1
        End If
    Next
    Application.ScreenUpdating = True

• excel
• vba
• copy-paste

• A couple of things. Set Num = Worksheets("Test1").Range("K:K" & L) - L isn't defined so will be 0 here which would cause your code to fail. Even if it was higher than 0 it would still be trying to reference the range K:K10 for example and that would fail as no row number on first reference. – Darren Bartrup-Cook Commented Mar 3 at 9:52
• Do you get an error if you remove On error resume next? – Shrotter Commented Mar 3 at 9:54
• 1 Also remove your On Error Resume Next as that could be hiding an error. – Darren Bartrup-Cook Commented Mar 3 at 9:54

1 Answer 1

Looking at your code:

    X = Worksheets("Test1").UsedRange.Rows.Count
    Y = Worksheets("Test2").UsedRange.Rows.Count
    If Y = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Test2").UsedRange) = 0 Then Y = 0
    End If

The Worksheet.UsedRange method is infamous for not always giving the result that people want/expect. Even if your worksheet is completely blank, if cell Z100 has, for example, had its text-formatting set to Bold (despite not containing any text), then Worksheet.UsedRange will (at a minimum) return A1:Z100.

This would mean that Y=100, and so your COUNTA test doesn't trigger — resulting in your data being added from Row 101 onwards.

The two common 'better' methods are Range.End and Range.CurrentRegion, like so:

X = Worksheets("Test1").Cells(Worksheets("Test1").Rows.Count,1).End(xlUp).Row
Y = Worksheets("Test2").Cells(Worksheets("Test2").Rows.Count,1).End(xlUp).Row
    If Y = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Test2").Rows(1)) = 0 Then Y = 0
    End If

''OR''

X = Worksheets("Test1").Cells(1,1).CurrentRegion.Rows.Count
Y = Worksheets("Test2").Cells(1,1).CurrentRegion.Rows.Count
    If Y = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Test2").Rows(1)) = 0 Then Y = 0
    End If

Alternatively, you could use a completely overkill function like this to get the "true" Used Data Range:

Private Function DataRange(ByRef ws As Worksheet) As Range
    Dim result As Range, review As Range, region As Range
    
    On Error Resume Next
    Set review = ws.UsedRange.SpecialCells(xlCellTypeConstants)
    Set region = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo -1
    On Error GoTo 0
    
    'Combine the Constants and Formulas into a single Range
    If Not (region Is Nothing) Then
        If review Is Nothing Then
            Set review = region
        Else
            Set review = Application.Union(review, region)
        End If
    End If
    Set region = Nothing
    
    If review Is Nothing Then
        'Sheet is Empty; return A1
        Set result = ws.Cells(1, 1)
    Else
        'loop through the different areas of the sheet with data, and combine them into a single rectangle that includes all cells with data
        Set result = review.Areas(1)
        For Each region In review.Areas
            Set result = ws.Range(result, region.CurrentRegion)
        Next region
    End If
    
    Set DataRange = result
End Function

and then use it like this:

    X = DataRange(Worksheets("Test1")).Rows.Count
    Y = DataRange(Worksheets("Test2")).UsedRange.Rows.Count
    If Y = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Test2").UsedRange) = 0 Then Y = 0
    End If