简体   繁体   中英

Paste into next empty column

Please help optimize this code if possible to run quicker. Currently program works as intended but I think their may be a better way to copy/paste data into next empty column besides this lengthy else if statement.

Sub compare()
Dim N
Dim mystr
Dim MyComp

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow
N = Range("A" & i)
mystr = Replace(N, Right(N, 8), "")

If Worksheets("Sheet1").Range("A2:A66000").Find(mystr) Is Nothing Then
    Else
    Set mystr = Worksheets("Sheet1").Range("A2:A66000").Find(mystr, LookAt:=xlWhole)
    cn = mystr.Address

'' Portion of code I wish to optimize   
 If IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 1)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 1)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 2)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 2)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 3)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 3)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 4)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 4)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 5)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 5)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 6)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 6)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 7)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 7)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 8)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 8)
    ElseIf IsEmpty(Worksheets("Sheet1").Range(cn).Offset(0, 9)) = True Then
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 9)
    Else
    Worksheets("Sheet2").Range("A" & i).Copy Worksheets("Sheet1").Range(cn).Offset(0, 10)
    End If

End If
Next i

End Sub

Use the Range.End method.

With Worksheets("Sheet1")
    .Cells(cn.Row,.Columns.Count).End(xlToLeft).Offset(,1).Value = _ 
        Worksheets("Sheet2").Range("A" & i).Value
End WIth

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM