Snasui Excel Forum

Code: Select all

Sub Copyitem_buy()
Dim r1 As Range, r2 As Range, rt As Range, rs As Range, LR As Long
With Worksheets("sheet1")
Set r1 = .Range("A2", .Range("B65536").End(xlUp))
Set r2 = r1.Offset(0, 2).Resize(, 9) 'copy 8 collum count from offset 0
Set rs = Union(r1, r2)
End With

If Worksheets("sheet1").Range("O3").End(xlUp) <> 0 Then
Set rt = Worksheets("ssjExport_Q1").Range("A6").End(xlUp).Offset(1, 0)
rs.Copy rt
Application.CutCopyMode = False
MsgBox "Finish copy."
Else

MsgBox "no copy"
End If


End Sub

Code: Select all

Sub Copyitem_buy()
    Dim r1 As Range, rt As Range, rs As Range, r As Range
    With Worksheets("sheet1")
        Set r1 = .Range("A7", .Range("A65536").End(xlUp))
    End With
    For Each r In r1
        If r.Offset(0, 14).Value <> 0 And IsNumeric(r.Offset(0, 14).Value) Then
            With Worksheets("Sheet1")
                Set rs = Union(r.Offset(0, 0), r.Offset(0, 2), r.Offset(0, 3))
            End With
            Set rt = Worksheets("ssjExport_Q1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            rs.Copy rt
            Application.CutCopyMode = False
        End If
    Next r
End Sub