VBA-Range(Selection, Selection.End(xlToLeft))

[george hart]

Hi

I have data I need to select then copy to another worksheet. The code below works fine if the data I want is in more than one row. But, when I have data in only one row it falls over because it copies the data I want and all the enty cells/rows below - this causes a problem when pasting, because paste area are not the same size/shape etc...I've tried changing the code in allsorts of ways but cant figure it out...I'm going mad!


Sheets("LAIRA STOP").Select
Cells.Find(What:="power cars", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Data").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Columns("B").Value = "LA"

 

[Norie]

george

Thanks for your patience and sorry for all the questions.

I think I get it now and know what the problem is.

When you xlDown it, well, goes down, so if you start at the last row of data then you'll end up on the last row in the column.

Give this a try.

Option Explicit
 
Sub ClosedClaims()
Dim wsLAND As Worksheet
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
Dim rngFnd As Range
Dim LastRow As Long
Dim LastCol As Long
 
    Set wsLAND = Worksheets("LANDORE")

    Set rngFnd = wsLAND.Range("A:A").Find(What:="power cars", After:=wsLAND.Range("A1"), LookIn:=xlFormulas, _
                                          LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                          MatchCase:=False)
                                                                                    
    If rngFnd Is Nothing Then
 
        MsgBox "Power Cars not found"
        
    Else
    
        ' data to copy starts in the row below 'Power Cars'
        Set rngCopyFrom = rngFnd.Offset(1)
 
        ' find the last row and column of data tto copy
        LastRow = wsLAND.Cells(Rows.Count, rngFnd.Column).End(xlUp).Row
        LastCol = wsLAND.Cells(rngCopyFrom.Row, Columns.Count).End(xlToLeft).Column

        ' expand range to copy down and across to the last cell
        Set rngCopyFrom = Range(rngCopyFrom, wsLAND.Cells(LastRow, LastCol))
 
        ' find next empty cell on 'Data' to copy to
        Set rngCopyTo = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
 
        ' copy
        rngCopyFrom.Copy
 
        ' paste
        rngCopyTo.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                               False, Transpose:=False
    End If
End Sub

 

[george hart]

Got it

This works. Got it from a colleague...

Range("a" & Selection.Row & ":f" & ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row).Select