VBA copy worksheets into one if a condition is met

sagarshah

New Member
Joined
Jan 25, 2017
Messages
10
Hello,

VBA to merge two worksheets into a new worksheet based on criteria.

Input Sheets : APA, BANK, GA
Output Sheets: APA PAYMENT & GA PAYMENT

I want to do the following:
  • Copy all data from APA sheet and paste to APA Payment
  • Copy data that contains "APA" in Column B from BANK sheet and paste to APA Payment
  • APA Payment Sort by date and add a subtotal

and...


  • Copy all data from GA sheet and paste to GA Payment
  • Copy data that contains "GA" in Column B from BANK sheet and paste to GA Payment
  • GA Payment Sort by date and add a subtotal

See example tables below :

INPUT SHEET : APA
NUMBERDATECLIENTDEBITCREDITDESCSHEETNAME
CH11/9/19CUST11000T1APA
CH22/9/19CUST22000T2APA

<tbody>
</tbody>


INPUT SHEET : GA
NUMBERDATECLIENTDEBITCREDITDESCSHEETNAME
CH1003/9/19CUST105000T10GA
CH1014/9/19CUST116000T11GA

<tbody>
</tbody>


INPUT SHEET : BANK
CHQDATECLIENTDEBITCREDITDESCSHEETNAME
BK15/9/19APA1000CUST1BANK
BK26/9/19APA2000CUST2BANK
BK36/9/19GA5000CUST10BANK

<tbody>
</tbody>



OUTPUT SHEET : APA PAYMENT (vba code)

INVDATECLIENTDEBITCREDITDESCSHEETNAME
CH11/9/19CUST11000T1APA PAYMENT
CH22/9/19CUST22000T2APA PAYMENT
BK15/9/19APA1000CUST1APA PAYMENT
bk26/9/19APA2000CUST2APA PAYMENT
TOTAL30003000APA PAYMENT

<tbody>
</tbody>


OUTPUT SHEET : GA PAYMENT (vba code)
INVDATECLIENTDEBITCREDITDESCSHEETNAME
CH1003/9/19CUST105000T10GA PAYMENT
CH1012/9/19CUST116000T11GA PAYMENT
BK36/9/19GA5000CUST10GA PAYMENT
TOTAL110005000GA PAYMENT


<tbody>
</tbody>


Thanks in advance.
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Hi i am not a coder but i tried.
try with the below code.

And if anyone in the forum could simplify this code.
Please do.

Code:
Option Explicit


Sub sagarshah()
Dim lrow, lrow1, lrow2 As Long
Dim i As Integer
Dim ws, ws1 As Worksheet


Worksheets.Add
ActiveSheet.Name = "APA_PAYMENT"
Set ws = Worksheets("APA_PAYMENT")
Worksheets("APA").Activate
Worksheets("APA").UsedRange.Select
Selection.Copy
Worksheets("APA_PAYMENT").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


With Worksheets("BANK")
    lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Cells(i, 3).Text = "APA" Then
            .Rows(i).Copy
            With Worksheets("APA_PAYMENT")
                lrow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("A" & lrow1 + 1).PasteSpecial
            End With
        End If
    Next i
End With
With ws.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=ws.Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange ws.Range("B2:B" & lrow1)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Application.CutCopyMode = False
Worksheets("APA_PAYMENT").Activate
lrow1 = Cells(Rows.Count, "A").End(xlUp).Row
For i = 4 To 5
    Cells(lrow1 + 1, i).Formula = "=SUM(" & Range(Cells(1, i), Cells(lrow1, i)).Address & ")"
Next


Worksheets.Add
ActiveSheet.Name = "GA_PAYMENT"
Set ws1 = Worksheets("GA_PAYMENT")
Worksheets("GA").Activate
Worksheets("GA").UsedRange.Select
Selection.Copy
Worksheets("GA_PAYMENT").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


With Worksheets("BANK")
    lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Cells(i, 3).Text = "GA" Then
            .Rows(i).Copy
            With Worksheets("GA_PAYMENT")
                lrow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("A" & lrow1 + 1).PasteSpecial
            End With
        End If
    Next i
End With
With ws.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=ws.Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange ws.Range("B2:B" & lrow1)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Application.CutCopyMode = False
Worksheets("GA_PAYMENT").Activate
lrow1 = Cells(Rows.Count, "A").End(xlUp).Row
For i = 4 To 5
    Cells(lrow1 + 1, i).Formula = "=SUM(" & Range(Cells(1, i), Cells(lrow1, i)).Address & ")"
Next
End Sub

Regards,
Dhruva.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

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