Results 1 to 10 of 10

Copy data using advanced filter across all sheets.

Threaded View

  1. #1
    Registered User
    Join Date
    10-19-2020
    Location
    India
    MS-Off Ver
    2013
    Posts
    5

    Copy data using advanced filter across all sheets.

    I am trying to create a macro which copies and pastes filtered data from all sheets of another workbook. The below code does the job but lacks accuracy in filtering data.

    Please note the database range is same across all sheets of another workbook (Headers on Row no.7)

    Accuracy Problem:
    It does not meet the criteria and pastes the entire data of sheet1 of the another workbook.
    Only the data of column A is pasted from other sheets, rest all the columns are blank.
    Expectations: The code should search for the given criteria in each sheet of another workbook. If no data found then move to another sheet and paste the entire filtered data in this workbook.

    Could anyone please help solve this?

    Sub Import_Data()
    
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim x As Integer
    Dim lcol, lrow As Long
    Dim ws As Worksheet
    
    
    
    
    Application.ScreenUpdating = False
    
    For Each ws In Worksheets
    ws.Calculate
    Next ws
    
    
    
    MsgBox ("1. Please select the LATEST time period file.")
    
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & import range", Filefilter:="Excel Files(.xls),xls")
    If FileToOpen <> False Then
    
    ThisWorkbook.Worksheets(10).Range(Cells(1, 9), Cells(Rows.Count, Columns.Count)).EntireColumn.Delete
    
    
    ThisWorkbook.Worksheets("Temp.Sheet").Cells.Clear
    
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    
    With OpenBook
    
    For Each ws In Worksheets
    
    With ws
    
    lcol = .Cells(7, .Columns.Count).End(xlToLeft).Column
    
    lrow = .Cells.Find(What:="*", _
    After:=.Range("A1"), _
    LookAt:=xlPart, _
    LookIn:=xlFormulas, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious, _
    MatchCase:=False).Row
    
    
    .Range(.Cells(7, 1), .Cells(lrow, lcol)).AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=ThisWorkbook.Worksheets(10).Range("C25:G27"), Copytorange:=ThisWorkbook.Worksheets("Temp.Sheet").Range("A7"), Unique:=False
    
    
    End With
    
    Next ws
    
    End With
    
    OpenBook.Close False
    
    Else
    
    Exit Sub
    
    End If
    
    
    If WorksheetFunction.CountA(Sheets("Temp.Sheet").Range("A8:XFD18")) = 0 Then
    
    Sheet10.Range(Cells(1, 9), Cells(Rows.Count, Columns.Count)).EntireColumn.Delete
    MsgBox ("No data found as per the criteria.")
    Exit Sub
    
    End If
    End Sub
    Attached Files Attached Files
    Last edited by hsm3005; 11-04-2020 at 10:23 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Replies: 0
    Last Post: 08-04-2017, 02:39 AM
  2. Replies: 0
    Last Post: 03-06-2017, 03:55 PM
  3. [SOLVED] Open file dynamically and copy data using advanced filter
    By 4gurus in forum Excel General
    Replies: 4
    Last Post: 09-11-2013, 07:06 AM
  4. advanced filter - button to re apply advanced filter across multiple sheets
    By motmac87 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 03-05-2013, 11:16 PM
  5. How to use advanced filter simultaneously in few sheets
    By markos17 in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 01-31-2011, 11:58 AM
  6. advanced filter on hidden sheets
    By imatomic in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 07-06-2009, 10:47 PM
  7. Advanced Filter on Protected Sheets?
    By documike in forum Excel General
    Replies: 1
    Last Post: 01-02-2005, 05:06 PM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1