Problem code copy invoice data to archive

Report
Posts
69
Registration date
Thursday July 18, 2019
Status
Member
Last seen
January 15, 2021
-
Posts
69
Registration date
Thursday July 18, 2019
Status
Member
Last seen
January 15, 2021
-
hi, experts
I've found this code from the internet , and I amended some ranges & sheets name , it works but not completely ,there is a problem about quantity , it doesn't copy to sheet "data" from sheet"invoice" in sheet data ,it shows the unit price in column quantity and column unit price is empty as in my pics 1 , and I would add the total in the last item as in pics3
note : total is cell e38

pic1 wrong result


pic 2 sheets"invoice" source data contain ( column a,b,c,d,e)


pic3 expected result in sheet"data"

the code :
Sub SaveButton_Click()
Dim Inv As Variant
Dim Tmp As Variant
Dim Items As Variant
Dim R As Long
Dim C As Long
With Worksheets("Invoice")
Inv = .Range("e3:e6").Value

R = .Cells(17, "A").End(xlDown).Row
Tmp = .Range(.Cells(17, "A"), .Cells(R, "e")).Value
End With
With Worksheets("Invoice 2")
With .Range("e3:e6")
Inv = .Value
.ClearContents
End With
R = .Cells(17, "A").End(xlDown).Row
With .Range(.Cells(17, "A"), .Cells(R, "e"))
Tmp = .Value
.ClearContents
End With
End With
ReDim Items(1 To UBound(Tmp), 1 To UBound(Tmp, 2) - 1)
For R = 1 To UBound(Tmp)
For C = 1 To UBound(Items, 2)
Items(R, C) = Tmp(R, C + IIf(C = UBound(Items, 2), 1, 0))
Next C
Next R

Application.ScreenUpdating = False
With Worksheets("DATA")
R = .Cells(.Rows.Count, "E").End(xlUp).Row + 1
.Range("A2:I2").Copy ' format new cells like first row
.Cells(R, "A").Resize(UBound(Items), UBound(Items, 2) + UBound(Inv)) _
.PasteSpecial xlPasteFormats
.Cells(R, "A").Resize(1, UBound(Inv)).Value = Application.Transpose(Inv)
.Cells(R, "E").Resize(UBound(Items), UBound(Items, 2)).Value = Items
End With
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub

so if anybody have suggestion to fix the code or alternative is ok

thanks in advance

1 reply

Posts
69
Registration date
Thursday July 18, 2019
Status
Member
Last seen
January 15, 2021

any suggestion or idea ?

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!