Snasui Excel Forum

Code: Select all

'***** USe copy All data to ssjExport after del module
Sub Copyitem_buy()
    Dim r1 As Range, rt As Range, rs As Range, r As Range
    With Worksheets("sheet1")
        Set r1 = .Range("A7", .Range("A1536").End(xlUp))
    End With
    For Each r In r1
        If r.Offset(0, 18).Value <> 0 And IsNumeric(r.Offset(0, 18).Value) Then
            With Worksheets("Sheet1")
            Set rs = Union(r.Offset(0, 0), r.Offset(0, 1), r.Offset(0, 2), r.Offset(0, 4), r.Offset(0, 6), _
                     r.Offset(0, 7), r.Offset(0, 8), r.Offset(0, 14), r.Offset(0, 16), r.Offset(0, 18), _
                     r.Offset(0, 19), r.Offset(0, 20), r.Offset(0, 21), r.Offset(0, 24), r.Offset(0, 27), r.Offset(0, 31), _
                     r.Offset(0, 35), r.Offset(0, 36))
            End With
            Set rt = Worksheets("ssjExport").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            rs.Copy rt
            
            Application.CutCopyMode = False
        End If
        
    Next r
   
    rt.Offset(1, 1).Value = " total"
    rt.Offset(1, 17).Value = " 99911"
    '****** sig name
    rt.Offset(4, 2).Value = " bkk name"
    rt.Offset(4, 10).Value = " fkfjkd name"
    
     rt.Offset(5, 2).Value = "(.....................)"
     rt.Offset(5, 10).Value = "(.....................)"

Code: Select all

Sub Copyitem_buy()
    Dim r1 As Range, rt As Range, rs As Range, r As Range
    Dim i As Integer
    With Worksheets("sheet1")
        Set r1 = .Range("A7", .Range("A1536").End(xlUp))
    End With
    For Each r In r1
        If r.Offset(0, 18).Value <> 0 And IsNumeric(r.Offset(0, 18).Value) Then
            With Worksheets("Sheet1")
            Set rs = Union(r.Offset(0, 0), r.Offset(0, 1), r.Offset(0, 2), r.Offset(0, 4), r.Offset(0, 6), _
                     r.Offset(0, 7), r.Offset(0, 8), r.Offset(0, 14), r.Offset(0, 16), r.Offset(0, 18), _
                     r.Offset(0, 19), r.Offset(0, 20), r.Offset(0, 21), r.Offset(0, 24), r.Offset(0, 27), r.Offset(0, 31), _
                     r.Offset(0, 35), r.Offset(0, 36))
            End With
            Set rt = Worksheets("ssjExport").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            rs.Copy rt
            i = i + 1
            rt.Value = i
            Application.CutCopyMode = False
        End If
        
    Next r
    rt.Offset(1, 1).Value = "Total"
    rt.Offset(1, 17).Value = Application.Sum(rt.Parent.Cells(8, "r").Resize(i))
    'rt.Offset(1, 17).Value = " 99911"
    '****** sig name
    rt.Offset(4, 2).Value = " bkk name"
    rt.Offset(4, 10).Value = " fkfjkd name"
    
     rt.Offset(5, 2).Value = "(.....................)"
     rt.Offset(5, 10).Value = "(.....................)"
End Sub