Apply Autofilter, check for autofilter criteria and Copy to dest

Search Home All Forums

Home

Microsoft Offic...

Microsoft Excel

Apply Autofilter, check for autofilter criteria and Copy to destination sheet

10/5/2011 10:28 AM

mclav

Joined: 10/5/2011

Posts: 22

Apply Autofilter, check for autofilter criteria and Copy to destination sheet

Hi,

I am novice in VBA, need expert advice for the following problem.
I have a Source workbook with 30 worksheets. I need to apply autofilter criteria to 10 worksheets. The autofilter needs to be applied to Worksheets named Sample1, Sample3, Sample5 etc. The autofilter range is D4 and Criteria is DD104.

Once the autofilter is applied to all 15 worksheets, I need to copy the data in range A4 till end of column where the last entry of data is present(the data can increase or decrease) from all 15 worksheets and paste it to Sheet1, A3 of Master workbook. I would also need to check if the autofilter criteria 'DD104' exists then filter and copy, if it does not exists then move to the next sheet.

Is it possible to automate the above activity using VBA? I have attached sample data (Source Workbook) and Master workbook.

Thanks

		Master.xlsx
		Source - Dummy Data1.xlsx

10/5/2011 3:45 PM

Ashish Mathur

www.ashishmathur.com
Joined: 11/17/2006

Posts: 1682

Re: Apply Autofilter, check for autofilter criteria and Copy to destination sheet

Hi,

Try this

1. Open both files
2. Click on any cell in the "Source - Dummy Data1" file
3. Right click on any tab and select View code
4. Go to Insert > Module
5. In the code windows, paste the following code

Sub transfer_filtered_data()
Application.ScreenUpdating = False
Dim lrow As Integer
Dim lrow1 As Integer
Dim rng As Range
Dim rng2 As Range
Workbooks("Source - Dummy Data1").Activate
Worksheets(1).Range("A1:N1").Copy
Workbooks("Master").Activate
Range("A1:P1").PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
Workbooks("Source - Dummy Data1").Activate
For n = 1 To Worksheets.Count Step 2
    lrow = Worksheets(n).Range("A3").CurrentRegion.Rows.Count
    Set rng = Worksheets(n).Range("A" & 3 & ":M" & lrow)
    rng.AutoFilter field:=4, Criteria1:="DD104"
    On Error GoTo Skip
    Set rng2 = Worksheets(n).Range("A3").Offset(1, 0).Resize(rng.Rows.Count - 1, 13).SpecialCells(xlCellTypeVisible)
    lrow1 = Workbooks("Master").Worksheets("sheet1").Cells(65000, 4).End(xlUp).Row + 1
    rng2.Copy Destination:=Workbooks("Master").Worksheets("sheet1").Range("A" & lrow1)
    Application.CutCopyMode = False
Skip:     Worksheets(n).AutoFilterMode = False
Next n
Workbooks("Master").Activate
Worksheets("sheet1").Range("A2").Select
Application.ScreenUpdating = True
End Sub

Hope this helps. Do let me know how this works for you.

I am also attaching the two files for your reference.

For Microsoft Excel trainings in India, please visit http://www.ashishmathur.com/corporate-interventions/

Regards,

Ashish Mathur -

Microsoft Excel MVP
Website
Blog
Follow @ExcelAshish

		Source - Dummy Data1.xls
		Master.xls

10/5/2011 6:35 PM

mclav

Joined: 10/5/2011

Posts: 22

Re: Apply Autofilter, check for autofilter criteria and Copy to destination sheet Modified By mclav on 10/5/2011 6:39:28 PM

hi Ashish,

Thanks for the response. I checked the code. The sample1 is gettting autofiltered but it is not pasting the data on Sheet 1 , A3 of Master xls :(

Thanks again!

10/6/2011 5:01 AM

Ashish Mathur

www.ashishmathur.com
Joined: 11/17/2006

Posts: 1682

Re: Apply Autofilter, check for autofilter criteria and Copy to destination sheet Modified By Ashish Mathur on 10/6/2011 5:03:42 AM

Hi,

It works absolutely fine for me. I just download the two files, saved them on the desktop and then opened both files. While on any sheet on the
Source - Dummy Data1.xls file, i just ran the macro. On the other file, in sheet1, all data appeared below row 3.

Please try again and be specific about the problem which you are facing.

For Microsoft Excel trainings in India, please visit http://www.ashishmathur.com/corporate-interventions/

Regards,

Ashish Mathur -

Microsoft Excel MVP
Website
Blog
Follow @ExcelAshish