Copying filtered data from a closed workbook..

B

Bumba

New Member
Joined
Jan 29, 2019
Messages
10
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
storedata.xlsx
ABCDEF
1Order IDOrder DateShip DateProduct NameBill ValueStatus
2CA-2016-15215608-11-201611-11-2016Bush Somerset Collection Bookcase£ 261.96Payment released on 18.11.16
3CA-2016-15215608-11-201611-11-2016Hon Deluxe Fabric Upholstered Stacking Chairs, Rounded Back£ 731.94
4CA-2016-13868812-06-201616-06-2016Self-Adhesive Address Labels for Typewriters by Universal£ 14.62Payment released on 23.06.16
5US-2015-10896611-10-201518-10-2015Bretford CR4500 Series Slim Rectangular Table£ 957.58Payment released on 25.10.15
6US-2015-10896611-10-201518-10-2015Eldon Fold 'N Roll Cart System£ 22.37Payment released on 25.10.15
7CA-2014-11581209-06-201414-06-2014Eldon Expressions Wood and Plastic Desk Accessories, Cherry Wood£ 48.86Payment released on 21.06.14
8CA-2014-11581209-06-201414-06-2014Newell 322£ 7.28Payment released on 21.06.14
9CA-2014-11581209-06-201414-06-2014Mitel 5320 IP Phone VoIP phone£ 907.15Payment released on 21.06.14
10CA-2014-11581209-06-201414-06-2014DXL Angle-View Binders with Locking Rings by Samsill£ 18.50Payment released on 21.06.14
11CA-2014-11581209-06-201414-06-2014Belkin F5C206VTEL 6 Outlet Surge£ 114.90Payment released on 21.06.14
12CA-2014-11581209-06-201414-06-2014Chromcraft Rectangular Conference Tables£ 1,706.18Payment released on 21.06.14
13CA-2014-11581209-06-201414-06-2014Konftel 250 Conference phone - Charcoal black£ 911.42Payment released on 21.06.14
14CA-2017-11441215-04-201720-04-2017Xerox 1967£ 15.55
15CA-2016-16138905-12-201610-12-2016Fellowes PB200 Plastic Comb Binding Machine£ 407.98
16US-2015-11898322-11-201526-11-2015Holmes Replacement Filter for HEPA Air Cleaner, Very Large Room, HEPA Filter£ 68.81Payment 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
RangeFormula
F2,F16,F4:F13F2="Payment released on "&TEXT(C2+7, "dd.mm.yy")

Sheet2
storedata.xlsx
ABCDEF
1Order IDOrder DateShip DateProduct NameBill ValueStatus
2US-2015-11898322-11-201526-11-2015Storex DuraTech Recycled Plastic Frosted Binders£ 2.54Payment released on 17.12.15
3CA-2014-10589311-11-201418-11-2014Stur-D-Stor Shelving, Vertical 5-Shelf: 72"H x 36"W x 18 1/2"D£ 665.88Payment released on 09.12.14
4CA-2014-16716413-05-201415-05-2014Fellowes Super Stor/Drawer£ 55.50Payment released on 05.06.14
5CA-2014-14333627-08-201401-09-2014Newell 341£ 8.56Payment released on 22.09.14
6CA-2014-14333627-08-201401-09-2014Cisco SPA 501G IP Phone£ 213.48Payment released on 22.09.14
7CA-2014-14333627-08-201401-09-2014Wilson Jones Hanging View Binder, White, 1"£ 22.72Payment released on 22.09.14
8CA-2016-13733009-12-201613-12-2016Newell 318£ 19.46
9CA-2016-13733009-12-201613-12-2016Acco Six-Outlet Power Strip, 4' Cord Length£ 60.34
10US-2017-15690916-07-201718-07-2017Global Deluxe Stacking Chair, Gray£ 71.37
11CA-2015-10632025-09-201530-09-2015Bretford CR4500 Series Slim Rectangular Table£ 1,044.63Payment released on 21.10.15
12CA-2016-12175516-01-201620-01-2016Wilson 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
RangeFormula
F11,F2:F7F2="Payment released on "&TEXT(C2+21, "dd.mm.yy")

Sheet3
storedata.xlsx
ABCDEF
1Order IDOrder DateShip DateProduct NameBill ValueStatus
2US-2015-15063017-09-201521-09-2015Howard Miller 13-3/4" Diameter Brushed Chrome Round Wall Clock£ 124.20Payment released on 12.10.15
3US-2015-15063017-09-201521-09-2015Poly String Tie Envelopes£ 3.26Payment released on 01.10.15
4US-2015-15063017-09-201521-09-2015BOSTON Model 1800 Electric Pencil Sharpeners, Putty/Woodgrain£ 86.30
5US-2015-15063017-09-201521-09-2015Acco Pressboard Covers with Storage Hooks, 14 7/8" x 11", Executive Red£ 6.86
6US-2015-15063017-09-201521-09-2015Lumber Crayons£ 15.76Payment released on 12.10.15
7CA-2017-10772719-10-201723-10-2017Easy-staple paper£ 29.47
8CA-2016-11759008-12-201610-12-2016GE 30524EE4£ 1,097.54Payment released on 31.12.16
9CA-2016-11759008-12-201610-12-2016Electrix Architect's Clamp-On Swing Arm Lamp, Black£ 190.92Payment released on 20.12.16
10CA-2015-11741527-12-201531-12-2015#10-4 1/8" x 9 1/2" Premium Diagonal Seam Envelopes£ 113.33
11CA-2015-11741527-12-201531-12-2015Atlantic Metals Mobile 3-Shelf Bookcases, Custom Colors£ 532.40Payment released on 21.01.16
12CA-2015-11741527-12-201531-12-2015Global Fabric Manager's Chair, Dark Gray£ 212.06
13CA-2015-11741527-12-201531-12-2015Plantronics HL10 Handset Lifter£ 371.17Payment released on 07.01.16
14CA-2017-12099910-09-201715-09-2017Panasonic Kx-TS550£ 147.17Payment released on 22.09.17
15
16
17
18
19
20
21
22
23
24
25
26
Sheet3
Cell Formulas
RangeFormula
F2,F11,F8,F6F2="Payment released on "&TEXT(C2+21, "dd.mm.yy")
F3,F9F3="Payment released on "&TEXT(C3+10, "dd.mm.yy")
F13:F14F13="Payment released on "&TEXT(C13+7, "dd.mm.yy")


and the workbook where I intend to paste the data looks like this:
copydata.xlsm
ABCDEFGHIJKL
1Order IDOrder DateShip DateProduct NameBill 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
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.
 

Attachments

  • msg.jpg
    msg.jpg
    157 KB · Views: 8

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Hi,

Check below code:

VBA Code: 
Sub copyData()
Dim source As Workbook
Dim dest As Workbook
Dim sh As Worksheet
Dim lastRow As Integer, sheetnum As Integer, rowno As Integer

Set dest = ThisWorkbook
Set source = Workbooks.Open(ActiveWorkbook.Path & "\" & "storeData.xlsx")
source.Activate

For sheetnum = 1 To source.Sheets.Count
    Set sh = source.Sheets(sheetnum)
    For rowno = 2 To sh.Cells(Rows.Count, 1).End(xlUp).Row
        lastRow = dest.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        If sh.Range("F" & rowno) = "" Then
            sh.Range(rowno & ":" & rowno).Copy
            dest.Activate
            Sheets("Sheet1").Cells(lastRow + 1, "A").Select
            ActiveSheet.Paste
        End If
    Next
Next
End Sub
 
Upvote 0
The destination workbook does not have a sheet called Sheet1 it is data. Anyways when I change that the code it gives me below result:
copydata.xlsm
ABCDEF
1Order IDOrder DateShip DateProduct NameBill Value
2CA-2016-15215608-11-201611-11-2016Hon Deluxe Fabric Upholstered Stacking Chairs, Rounded Back£ 731.94
3CA-2017-11441215-04-201720-04-2017Xerox 1967£ 15.55
4CA-2016-16138905-12-201610-12-2016Fellowes PB200 Plastic Comb Binding Machine£ 407.98
5CA-2016-13733009-12-201613-12-2016Newell 318£ 19.46
6CA-2016-13733009-12-201613-12-2016Acco Six-Outlet Power Strip, 4' Cord Length£ 60.34
7US-2017-15690916-07-201718-07-2017Global Deluxe Stacking Chair, Gray£ 71.37
8CA-2016-12175516-01-201620-01-2016Wilson Jones Active Use Binders£ 11.65
9US-2015-15063017-09-201521-09-2015BOSTON Model 1800 Electric Pencil Sharpeners, Putty/Woodgrain£ 86.30
10US-2015-15063017-09-201521-09-2015Acco Pressboard Covers with Storage Hooks, 14 7/8" x 11", Executive Red£ 6.86
11CA-2017-10772719-10-201723-10-2017Easy-staple paper£ 29.47
12CA-2015-11741527-12-201531-12-2015#10-4 1/8" x 9 1/2" Premium Diagonal Seam Envelopes£ 113.33
13CA-2015-11741527-12-201531-12-2015Global Fabric Manager's Chair, Dark Gray£ 212.06
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
data

and the storedata.xlsx file is kept open which is not what I want. I want the storedata.xlsx file to get automatically closed without saving any changes (its data must not change).
Also as you are copying the entire row(I think) the formatting of the other cells and their value if present may be in a different column is showing in the result which I don't want.
The columns to copy will be from column A to E.
Your code is pretty close though.
Thanks
 
Upvote 0
Hi
VBA Code: 
Sub copyData()
    Dim src As Workbook
    Dim dest As Workbook
    Dim i As Integer
    Set dest = ThisWorkbook
    Application.ScreenUpdating = False
    Set src = Workbooks.Open(ActiveWorkbook.Path & "\" & "storeData.xlsx")
    With src
        For i = 1 To .Sheets.Count
            With .Sheets(i).Range("a1")
                .AutoFilter
                .AutoFilter Field:=6, Criteria1:="="
                .CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).Copy dest.Sheets("Data").Range("A" & dest.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1)
            End With
        Next
    End With
    src.Close False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
HI mohadin, your code also has the same problem i.e. if I add additional columns in any/all of the sheets of storedata.xlsx I still want to get the data from only column A to column E.

Hope you understood it.:)

Thanks in advance
 
Upvote 0
Hi,

Below code is with required changes.

VBA Code: 
Sub copyData()
Dim source As Workbook
Dim dest As Workbook
Dim sh As Worksheet
Dim lastRow As Integer, sheetnum As Integer, rowno As Integer

Set dest = ThisWorkbook
Set source = Workbooks.Open(ActiveWorkbook.Path & "\" & "storeData.xlsx")
source.Activate
Application.ScreenUpdating = False
For sheetnum = 1 To source.Sheets.Count
    Set sh = source.Sheets(sheetnum)
    For rowno = 2 To sh.Cells(Rows.Count, 1).End(xlUp).Row
        lastRow = dest.Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
        If sh.Range("F" & rowno) = "" Then
            sh.Range("A" & rowno & ":E" & rowno).Copy
            dest.Activate
            Sheets("data").Cells(lastRow + 1, "A").Select
            ActiveSheet.Paste
        End If
    Next
Next

source.Close
Application.ScreenUpdating = True
End Sub
 
Upvote 0
VBA Code: 
Sub copyData()
    Dim src As Workbook
    Dim dest As Workbook
    Dim i As Integer
    Set dest = ThisWorkbook
    Application.ScreenUpdating = False
    Set src = Workbooks.Open(ActiveWorkbook.Path & "\" & "storeData.xlsx")
    With src
        For i = 1 To .Sheets.Count
            With .Sheets(i).Range("a1")
                .AutoFilter
                .AutoFilter Field:=6, Criteria1:="="
                .CurrentRegion.Resize(, 5).Offset(1).SpecialCells(xlCellTypeVisible).Copy dest.Sheets("Data").Range("A" & dest.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1)
            End With
        Next
    End With
    src.Close False
    Application.ScreenUpdating = True
End Sub
Just a minor change In
VBA Code: 
.CurrentRegion.Resize(, 5).Offset(1).SpecialCells........
 
Upvote 0
Solution
You are welcome
And thank you for the feedback
Be happy & safe
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question
Extract Data from One Worksheet to Another
Replies
6
Views
1K
mumps
mumps
R
  • Question
Copying data from a variable workbook
Replies
0
Views
409
Raghuveer20
R
B
  • Question
Change VBA to insert copied rows not paste them.
Replies
1
Views
2K
baby_kay_2003
B

Forum statistics

Threads
1,214,415
Messages
6,119,377
Members
448,888
Latest member
Arle8907

Share this page

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