VBA code to copy Paste special value to another sheet based on cell value

Arkays

New Member
Joined
Apr 12, 2018
Messages
2
Hi All..

i have a database sheet get updates if its paid or partially paid or pending, i need to move the paid & partial to the paid Sheet based on the cell Value, i did my best from research and managed to have the below, however, what i have noticed few things
1- the pasted value does not past value and keeps formulas.
2- it is not removing the duplicated partial rows

here below is my code

Code:
Sub TransferData()

Dim KeyCells As Range
Set KeyCells = Sheet3.Range("Z1")

If KeyCells.Value = False Then

If MsgBox("No Paid Invoices to Transfer?", vbOK) = vbOK Then Exit Sub

Else

If MsgBox("Paid Invoices will be Transfered to Paid Sheet", vbOKCancel) = vbCancel Then Exit Sub
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False

         Range("Z3", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 26, "Paid"
         Range("A4", Range("AA" & Rows.Count).End(xlUp)).Copy Sheet4.Range("A" & Rows.Count).End(xlUp)(2)
         Range("A4", Range("AA" & Rows.Count).End(xlUp)).Delete
         Range("Z3", Range("Z" & Rows.Count).End(xlUp)).AutoFilter 26, "Partial"
         Range("A4", Range("AA" & Rows.Count).End(xlUp)).Copy Sheet4.Range("A" & Rows.Count).End(xlUp)(2)

ActiveSheet.ShowAllData
     
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True

     Call Button2_Click
     Call Button1_Click

Sheet3.Select

End If

End Sub

********************************************


Code:
Sub Button2_Click()

    Sheets("Paid").Select
    ActiveSheet.Range("$A$4:$AA$1900").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _
        7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27), Header:=xlYes
End Sub


*********************************************

Sub Button1_Click()
'
' Button1_Click Macro
'

'
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("A2").Select
End Sub


********************************

Thanks :cool:
 
Last edited by a moderator:

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Forum statistics

Threads
1,214,636
Messages
6,120,669
Members
448,977
Latest member
moonlight6

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top