VBA copy worksheets into one if a condition is met

sagarshah

New Member
Joined
Jan 25, 2017
Messages
8
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.
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

GirishDhruva

Active Member
Joined
Mar 26, 2019
Messages
273
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,567
Messages
5,469,453
Members
406,652
Latest member
LJA

This Week's Hot Topics

Top