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