Hi All,
I am quite new to this and I have gotten so far but I can't seem to find a structure to do what I need to do.
Below I have attached Workbook1 and Workbook2. I can move data from both workbooks, but I was to paste to a row/column that has a specific value in Workbook2.
In my code, I can find the rows containing 301 and 302, and then copy them. I do not want to assign a column/row when pasting to the Workbook2. Is there anyway I could read Workbook2, find "Account 301" in column A, skip the subheadings (row below), and search for "- AE" in column E, then paste all additional rows copied from 301 from Workbook1 to this row?
Thanks in advance!
I am quite new to this and I have gotten so far but I can't seem to find a structure to do what I need to do.
Below I have attached Workbook1 and Workbook2. I can move data from both workbooks, but I was to paste to a row/column that has a specific value in Workbook2.
In my code, I can find the rows containing 301 and 302, and then copy them. I do not want to assign a column/row when pasting to the Workbook2. Is there anyway I could read Workbook2, find "Account 301" in column A, skip the subheadings (row below), and search for "- AE" in column E, then paste all additional rows copied from 301 from Workbook1 to this row?
Workbook1.xlsm | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
1 | Account: 301 | |||||||||
2 | ||||||||||
3 | Date | Details | Reference | Type | Debit | Credit | Balance | |||
4 | ||||||||||
5 | 21/01/2019 | PURCHASE | 301 | Bank | 665.00 | - | 665.00 | |||
6 | 19/03/2019 | PURCHASE | 301 | Bank | 120.00 | - | 785.00 | |||
7 | 01/04/2019 | PURCHASE | 301 | Bank | 384.00 | - | 1,169.00 | |||
8 | 03/05/2019 | PURCHASE | 301 | Bank | 500.00 | - | 1,669.00 | |||
9 | 10/05/2019 | PURCHASE | 301 | Bank | 500.00 | - | 2,169.00 | |||
10 | 10/05/2019 | PURCHASE | 301 | Bank | 500.00 | - | 2,669.00 | |||
11 | 17/05/2019 | PURCHASE | 301 | Bank | 500.00 | - | 3,169.00 | |||
12 | 23/05/2019 | PURCHASE | 301 | Bank | 500.00 | - | 3,669.00 | |||
13 | 29/05/2019 | PURCHASE | 301 | Bank | 585.00 | - | 4,254.00 | |||
14 | ||||||||||
15 | Account: 302 | |||||||||
16 | ||||||||||
17 | Date | Details | Reference | Type | Debit | Credit | Balance | |||
18 | ||||||||||
19 | 21/01/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 1,000.00 | |||
20 | 18/02/2019 | PURCHASE | 302 | Bank | 500.00 | - | 1,500.00 | |||
21 | 01/03/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 2,500.00 | |||
22 | 13/03/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 3,500.00 | |||
23 | 18/04/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 4,500.00 | |||
24 | 31/05/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 5,500.00 | |||
25 | 19/06/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 6,500.00 | |||
26 | 02/07/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 7,500.00 | |||
27 | 26/07/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 8,500.00 | |||
28 | 06/08/2019 | PURCHASE | 302 | Bank | 1,000.00 | - | 9,500.00 | |||
Sheet6 |
Workbook2.xlsx | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
1 | Account 301 | |||||||||
2 | Tran No. | Bat No. | Date | Ref No. | Narrative | Debit | Credit | Balance | ||
3 | 744 | 331 | 31/12/2019 | EC | Wages - AE | 21439.00 | 0.00 | 21439.00 | ||
4 | 772 | 336 | 31/12/2019 | EC | Narrative | 6580.96 | 0.00 | 28019.96 | ||
5 | 775 | 337 | 31/12/2019 | EC | Narrative | 19.64 | 0.00 | 28039.60 | ||
6 | 28039.60 | 0.00 | 28039.60 | |||||||
7 | ||||||||||
8 | Account 302 | |||||||||
9 | Tran No. | Bat No. | Date | Ref No. | Narrative | Debit | Credit | Balance | ||
10 | 745 | 331 | 31/12/2019 | EC | D.R- AE | 16500.00 | 0.00 | 16500.00 | ||
11 | 773 | 336 | 31/12/2019 | EC | Narrative | 9953.52 | 0.00 | 26453.52 | ||
Sheet2 |
VBA Code:
Sub Test()
Dim x As Workbook 'Determining Workbook
Dim y As Workbook 'Determining Workbook
Set x = Workbooks.Open("Workbook1.xlsm") 'Opens Workbook1
Set y = Workbooks.Open("Workbook2.xlsx") 'Opens Workbook2
Dim rw As Long, Cell As Range
For Each Cell In x.Sheets("Sheet5").Range("D2:D1000") 'Range of read first workbook
rw = Cell.Row
If Cell.Value = "301" Then 'Search for 301
Cell.EntireRow.Copy 'Copies entire row containing 302
y.Sheets("Sheet2").Range("A1").Insert xlShiftDown 'Pastes to Workbook2 on a designated line and creates more below it
End If
If Cell.Value = "302" Then 'Search for 302
Cell.EntireRow.Copy 'Copies entire row containing 302
y.Sheets("Sheet2").Range("A50").Insert xlShiftDown 'Pastes to Workbook2 on a designated line and creates more below it
End If
Next
End Sub
Thanks in advance!