Sub SelectAllReleventText()
Do While Range(“A1”).Offset(1, 6) <> Empty
Rows(ActiveCell.Row).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Here is my script, I've been told it doesn't do what it is meant to, which I expected since this was my first attempt. I am coming up with a variable not defined error. I thought I defined the variable, but I guess it wasn't specific enough for Excel VBA.
This is what I am attempting to do.
Thanks in advance. Just a heads up, I am using the Options Explicit in my VBA because I was told it was the "right way to do thing"...
Yes using Option Explicit is a good habit. Using .Select however is not :) it reduces the speed of the code. Also fully justify sheet names else the code will always run for the Activesheet which might not be what you actually wanted.
Is this what you are trying?
Option Explicit
Sub Sample()
    Dim lastRow As Long, i As Long
    Dim CopyRange As Range
    '~~> Change Sheet1 to relevant sheet name
    With Sheets("Sheet1")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To lastRow
            If Len(Trim(.Range("A" & i).Value)) <> 0 Then
                If CopyRange Is Nothing Then
                    Set CopyRange = .Rows(i)
                Else
                    Set CopyRange = Union(CopyRange, .Rows(i))
                End If
            Else
                Exit For
            End If
        Next
        If Not CopyRange Is Nothing Then
            '~~> Change Sheet2 to relevant sheet name
            CopyRange.Copy Sheets("Sheet2").Rows(1)
        End If
    End With
End Sub
NOTE
If if you have data from Row 2 till Row 10 and row 11 is blank and then you have data again from Row 12 then the above code will only copy data from Row 2 till Row 10
If you want to copy all rows which have data then use this code.
Option Explicit
Sub Sample()
    Dim lastRow As Long, i As Long
    Dim CopyRange As Range
    '~~> Change Sheet1 to relevant sheet name
    With Sheets("Sheet1")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To lastRow
            If Len(Trim(.Range("A" & i).Value)) <> 0 Then
                If CopyRange Is Nothing Then
                    Set CopyRange = .Rows(i)
                Else
                    Set CopyRange = Union(CopyRange, .Rows(i))
                End If
            End If
        Next
        If Not CopyRange Is Nothing Then
            '~~> Change Sheet2 to relevant sheet name
            CopyRange.Copy Sheets("Sheet2").Rows(1)
        End If
    End With
End Sub
Hope this is what you wanted?
Sid
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With