Hi all,
Code works fine till 'Remove duplicates. It does nothing after pasting data. Does anybody know how to fix 'Remove duplicates and 'Drag down formulas?
Code works fine till 'Remove duplicates. It does nothing after pasting data. Does anybody know how to fix 'Remove duplicates and 'Drag down formulas?
VBA Code:
Sub PricingTransferZVOL()
'Delete old data in LSMW ZVOL MATERIAL sheet
Worksheets("LSMW ZVOL MATERIAL").Rows(7 & ":" & Worksheets("LSMW ZVOL MATERIAL").Rows.Count).Delete
'Set filters to ZVOL
Call Removefilters
Call ZVOLFilter
Dim answer As Integer
Dim LastRowZVOL As Integer
Dim UsdRw As Integer
Dim LastRow As Integer
LastRow = Worksheets("SUM").Cells(Rows.Count, 1).End(xlUp).Row
LastRowZVOL = Worksheets("LSMW ZVOL MATERIAL").range("B" & Rows.Count).End(xlUp).Row
UsdRw = Worksheets("LSMW ZVOL MATERIAL").range("B" & Rows.Count).End(xlUp).Row
On Error GoTo Done
'Pop-up: Continue with macro?
answer = MsgBox("Continue?", vbQuestion + vbYesNo + vbDefaultButton2, "ZVOL Material")
If answer = vbYes Then
'Copy and paste data
Worksheets("SUM").range("AT3:AW" & LastRow).Select
Selection.Copy Worksheets("LSMW ZVOL MATERIAL").range("A4")
Worksheets("LSMW ZVOL MATERIAL").range("A4:D" & LastRowZVOL).RemoveDuplicates Columns:=Array(1, 2, 3, 4)
Application.CutCopyMode = False
'Remove duplicates
Worksheets("LSMW ZVOL MATERIAL").range("A4:D" & LastRowZVOL).RemoveDuplicates Columns:=Array(1, 2, 3, 4)
'Drag down formulas
Worksheets("LSMW ZVOL MATERIAL").range("E5:AA5").AutoFill _
Destination:=Worksheets("LSMW ZVOL MATERIAL").range("E5:AA" & UsdRw), _
Type:=xlFillCopy
End If
Done:
On Error GoTo 0
End Sub