Hi, I have a workbook where there are data of similar types in 3 sheets all with the same header. Now I want to copy the range of data(where the column Status is blank) from all of those sheets to a macro enabled workbook.
The database worksheet looks like this:
Sheet1
Sheet2
Sheet3
and the workbook where I intend to paste the data looks like this:
The code I've done:
I'm getting the attached message upon running the code. Why is that and how to stop it. Further, my code is not that efficient I think, so how to make it more efficient?
Also, is using usedrange a good idea in this case as it selecting a lot of blank cell data while copying.
Please help.
The database worksheet looks like this:
Sheet1
storedata.xlsx | ||||||||
---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | |||
1 | Order ID | Order Date | Ship Date | Product Name | Bill Value | Status | ||
2 | CA-2016-152156 | 08-11-2016 | 11-11-2016 | Bush Somerset Collection Bookcase | £ 261.96 | Payment released on 18.11.16 | ||
3 | CA-2016-152156 | 08-11-2016 | 11-11-2016 | Hon Deluxe Fabric Upholstered Stacking Chairs, Rounded Back | £ 731.94 | |||
4 | CA-2016-138688 | 12-06-2016 | 16-06-2016 | Self-Adhesive Address Labels for Typewriters by Universal | £ 14.62 | Payment released on 23.06.16 | ||
5 | US-2015-108966 | 11-10-2015 | 18-10-2015 | Bretford CR4500 Series Slim Rectangular Table | £ 957.58 | Payment released on 25.10.15 | ||
6 | US-2015-108966 | 11-10-2015 | 18-10-2015 | Eldon Fold 'N Roll Cart System | £ 22.37 | Payment released on 25.10.15 | ||
7 | CA-2014-115812 | 09-06-2014 | 14-06-2014 | Eldon Expressions Wood and Plastic Desk Accessories, Cherry Wood | £ 48.86 | Payment released on 21.06.14 | ||
8 | CA-2014-115812 | 09-06-2014 | 14-06-2014 | Newell 322 | £ 7.28 | Payment released on 21.06.14 | ||
9 | CA-2014-115812 | 09-06-2014 | 14-06-2014 | Mitel 5320 IP Phone VoIP phone | £ 907.15 | Payment released on 21.06.14 | ||
10 | CA-2014-115812 | 09-06-2014 | 14-06-2014 | DXL Angle-View Binders with Locking Rings by Samsill | £ 18.50 | Payment released on 21.06.14 | ||
11 | CA-2014-115812 | 09-06-2014 | 14-06-2014 | Belkin F5C206VTEL 6 Outlet Surge | £ 114.90 | Payment released on 21.06.14 | ||
12 | CA-2014-115812 | 09-06-2014 | 14-06-2014 | Chromcraft Rectangular Conference Tables | £ 1,706.18 | Payment released on 21.06.14 | ||
13 | CA-2014-115812 | 09-06-2014 | 14-06-2014 | Konftel 250 Conference phone - Charcoal black | £ 911.42 | Payment released on 21.06.14 | ||
14 | CA-2017-114412 | 15-04-2017 | 20-04-2017 | Xerox 1967 | £ 15.55 | |||
15 | CA-2016-161389 | 05-12-2016 | 10-12-2016 | Fellowes PB200 Plastic Comb Binding Machine | £ 407.98 | |||
16 | US-2015-118983 | 22-11-2015 | 26-11-2015 | Holmes Replacement Filter for HEPA Air Cleaner, Very Large Room, HEPA Filter | £ 68.81 | Payment released on 03.12.15 | ||
17 | ||||||||
18 | ||||||||
19 | ||||||||
20 | ||||||||
21 | ||||||||
22 | ||||||||
23 | ||||||||
24 | ||||||||
25 | ||||||||
26 | ||||||||
27 | ||||||||
28 | ||||||||
29 | ||||||||
30 | ||||||||
31 | ||||||||
32 | ||||||||
33 | ||||||||
34 | ||||||||
35 | ||||||||
36 | ||||||||
37 | ||||||||
38 | ||||||||
Sheet1 |
Cell Formulas | ||
---|---|---|
Range | Formula | |
F2,F16,F4:F13 | F2 | ="Payment released on "&TEXT(C2+7, "dd.mm.yy") |
Sheet2
storedata.xlsx | ||||||||
---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | |||
1 | Order ID | Order Date | Ship Date | Product Name | Bill Value | Status | ||
2 | US-2015-118983 | 22-11-2015 | 26-11-2015 | Storex DuraTech Recycled Plastic Frosted Binders | £ 2.54 | Payment released on 17.12.15 | ||
3 | CA-2014-105893 | 11-11-2014 | 18-11-2014 | Stur-D-Stor Shelving, Vertical 5-Shelf: 72"H x 36"W x 18 1/2"D | £ 665.88 | Payment released on 09.12.14 | ||
4 | CA-2014-167164 | 13-05-2014 | 15-05-2014 | Fellowes Super Stor/Drawer | £ 55.50 | Payment released on 05.06.14 | ||
5 | CA-2014-143336 | 27-08-2014 | 01-09-2014 | Newell 341 | £ 8.56 | Payment released on 22.09.14 | ||
6 | CA-2014-143336 | 27-08-2014 | 01-09-2014 | Cisco SPA 501G IP Phone | £ 213.48 | Payment released on 22.09.14 | ||
7 | CA-2014-143336 | 27-08-2014 | 01-09-2014 | Wilson Jones Hanging View Binder, White, 1" | £ 22.72 | Payment released on 22.09.14 | ||
8 | CA-2016-137330 | 09-12-2016 | 13-12-2016 | Newell 318 | £ 19.46 | |||
9 | CA-2016-137330 | 09-12-2016 | 13-12-2016 | Acco Six-Outlet Power Strip, 4' Cord Length | £ 60.34 | |||
10 | US-2017-156909 | 16-07-2017 | 18-07-2017 | Global Deluxe Stacking Chair, Gray | £ 71.37 | |||
11 | CA-2015-106320 | 25-09-2015 | 30-09-2015 | Bretford CR4500 Series Slim Rectangular Table | £ 1,044.63 | Payment released on 21.10.15 | ||
12 | CA-2016-121755 | 16-01-2016 | 20-01-2016 | Wilson Jones Active Use Binders | £ 11.65 | |||
13 | ||||||||
14 | ||||||||
15 | ||||||||
16 | ||||||||
17 | ||||||||
18 | ||||||||
19 | ||||||||
20 | ||||||||
21 | ||||||||
22 | ||||||||
23 | ||||||||
24 | ||||||||
25 | ||||||||
26 | ||||||||
27 | ||||||||
28 | ||||||||
29 | ||||||||
30 | ||||||||
31 | ||||||||
32 | ||||||||
33 | ||||||||
34 | ||||||||
35 | ||||||||
Sheet2 |
Cell Formulas | ||
---|---|---|
Range | Formula | |
F11,F2:F7 | F2 | ="Payment released on "&TEXT(C2+21, "dd.mm.yy") |
Sheet3
storedata.xlsx | ||||||||
---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | |||
1 | Order ID | Order Date | Ship Date | Product Name | Bill Value | Status | ||
2 | US-2015-150630 | 17-09-2015 | 21-09-2015 | Howard Miller 13-3/4" Diameter Brushed Chrome Round Wall Clock | £ 124.20 | Payment released on 12.10.15 | ||
3 | US-2015-150630 | 17-09-2015 | 21-09-2015 | Poly String Tie Envelopes | £ 3.26 | Payment released on 01.10.15 | ||
4 | US-2015-150630 | 17-09-2015 | 21-09-2015 | BOSTON Model 1800 Electric Pencil Sharpeners, Putty/Woodgrain | £ 86.30 | |||
5 | US-2015-150630 | 17-09-2015 | 21-09-2015 | Acco Pressboard Covers with Storage Hooks, 14 7/8" x 11", Executive Red | £ 6.86 | |||
6 | US-2015-150630 | 17-09-2015 | 21-09-2015 | Lumber Crayons | £ 15.76 | Payment released on 12.10.15 | ||
7 | CA-2017-107727 | 19-10-2017 | 23-10-2017 | Easy-staple paper | £ 29.47 | |||
8 | CA-2016-117590 | 08-12-2016 | 10-12-2016 | GE 30524EE4 | £ 1,097.54 | Payment released on 31.12.16 | ||
9 | CA-2016-117590 | 08-12-2016 | 10-12-2016 | Electrix Architect's Clamp-On Swing Arm Lamp, Black | £ 190.92 | Payment released on 20.12.16 | ||
10 | CA-2015-117415 | 27-12-2015 | 31-12-2015 | #10-4 1/8" x 9 1/2" Premium Diagonal Seam Envelopes | £ 113.33 | |||
11 | CA-2015-117415 | 27-12-2015 | 31-12-2015 | Atlantic Metals Mobile 3-Shelf Bookcases, Custom Colors | £ 532.40 | Payment released on 21.01.16 | ||
12 | CA-2015-117415 | 27-12-2015 | 31-12-2015 | Global Fabric Manager's Chair, Dark Gray | £ 212.06 | |||
13 | CA-2015-117415 | 27-12-2015 | 31-12-2015 | Plantronics HL10 Handset Lifter | £ 371.17 | Payment released on 07.01.16 | ||
14 | CA-2017-120999 | 10-09-2017 | 15-09-2017 | Panasonic Kx-TS550 | £ 147.17 | Payment released on 22.09.17 | ||
15 | ||||||||
16 | ||||||||
17 | ||||||||
18 | ||||||||
19 | ||||||||
20 | ||||||||
21 | ||||||||
22 | ||||||||
23 | ||||||||
24 | ||||||||
25 | ||||||||
26 | ||||||||
Sheet3 |
Cell Formulas | ||
---|---|---|
Range | Formula | |
F2,F11,F8,F6 | F2 | ="Payment released on "&TEXT(C2+21, "dd.mm.yy") |
F3,F9 | F3 | ="Payment released on "&TEXT(C3+10, "dd.mm.yy") |
F13:F14 | F13 | ="Payment released on "&TEXT(C13+7, "dd.mm.yy") |
and the workbook where I intend to paste the data looks like this:
copydata.xlsm | ||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | |||
1 | Order ID | Order Date | Ship Date | Product Name | Bill Value | |||||||||
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 | ||||||||||||||
28 | ||||||||||||||
data |
The code I've done:
VBA Code:
Sub Button1_Click()
Application.ScreenUpdating = False
Dim source_wb As Workbook
Dim source_sh1 As Worksheet
Dim source_sh2 As Worksheet
Dim source_sh3 As Worksheet
Dim dest_sh As Worksheet
Set source_wb = Application.Workbooks.Open("D:\New folder\storedata.xlsx", True, True)
Set source_sh1 = source_wb.Sheets("Sheet1")
Set source_sh2 = source_wb.Sheets("Sheet2")
Set source_sh3 = source_wb.Sheets("Sheet3")
Set dest_sh = ThisWorkbook.Sheets("data")
dest_sh.AutoFilterMode = False
dest_sh.Range("A2:E1000").ClearContents
source_sh1.UsedRange.AutoFilter 6, ""
source_sh1.UsedRange.Offset(1, 0).Copy
dest_sh.Cells(dest_sh.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
source_sh2.UsedRange.AutoFilter 6, ""
source_sh2.UsedRange.Offset(1, 0).Copy
dest_sh.Cells(dest_sh.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
source_sh3.UsedRange.AutoFilter 6, ""
source_sh3.UsedRange.Offset(1, 0).Copy
dest_sh.Cells(dest_sh.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
source_wb.Close False
Application.ScreenUpdating = True
End Sub
Also, is using usedrange a good idea in this case as it selecting a lot of blank cell data while copying.
Please help.