Search code examples
excelvbacopy-paste

Copied cells does not always apear at the top av the pasted sheet


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

Solution

  • 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