Вставить в следующий пустой столбец

Question

Пожалуйста, помогите оптимизировать этот код, если возможно, чтобы он работал быстрее. В настоящее время программа работает как задумано, но я думаю, что они могут быть лучшим способом скопировать / вставить данные в следующий пустой столбец, кроме этого длинного оператора if.

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

Answer 1

Используйте метод Range.End.

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