Snasui Excel Forum

Code: Select all

Sub test()
    Columns("A:E").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

Code: Select all

'Other code
Dim rngAll As Range
Dim j As Long, r As Range
Dim i As Integer, k As Integer
With Sheets("Sheet1")
    Set rngAll = .Range("e2", .Range("a" & .Rows.Count).End(xlUp))
    i = rngAll.Rows.Count
End With
With Sheets("Sheet2")
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    With .Range("a" & .Rows.Count).End(xlUp)
        .Offset(1, 1).Resize(i, 5).Value = rngAll.Value
        For k = 1 To i
           .Offset(k, 0).Value = k + j
        Next k
    End With
End With
'Other code

Code: Select all

Sub test()
Dim rngAll As Range
Dim j As Long, r As Range
Dim i As Integer, k As Integer
With Sheets("Sheet1")
    Range("A2:J2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Set rngAll = .Range("j2", .Range("a" & .Rows.Count).End(xlUp))
    i = rngAll.Rows.Count
End With
With Sheets("Sheet2")
    Sheets("Sheet2").Select
    Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    With .Range("a" & .Rows.Count).End(xlUp)
        .Offset(1, 1).Resize(i, 11).Value = rngAll.Value
        For k = 1 To i
           .Offset(k, 0).Value = k + j
        Next k
    End With
    Sheets("Sheet1").Select
End With
End Sub

Code: Select all

'Other code
With Sheets("Sheet1")
    If .Range("a2").Value = "" Then Exit Sub
    Set rngAll = .Range("j2", .Range("a" & .Rows.Count).End(xlUp))
    i = rngAll.Rows.Count
End With
'Other code

Code: Select all

Dim rngAll As Range
Dim j As Long, r As Range
Dim k As Integer
With Sheets("Sheet1")
    If .Range("a2").Value = "" Then Exit Sub
    Set rngAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
End With
With Sheets("Sheet2")
    If .Range("a2").Value = "" Then
        j = 0
    Else
        j = .Range("a" & .Rows.Count).End(xlUp).Value
    End If
    For Each r In rngAll
        If Application.CountIf(.Range("e:e"), r.Offset(0, 3).Value) = 0 Then
            j = j + 1
            With .Range("a" & .Rows.Count).End(xlUp)
                .Offset(1, 1).Resize(1, 10).Value = r.Resize(1, 10).Value
                .Offset(1, 0).Value = j
            End With
        End If
    Next r
End With