Combine macro

[SasiKumar007]

Dear Experts,

I have created macro to open the multiple excel file available on the particular path and apply the filter in second sheet including the blank rows and filter only the values in L column and copy the data to new sheet and paste there . Next file data will paste below to the last row.

Issue :

1 . This macro is working on local drive but file saved in one drive was not working. Pls help to change code to select the file from folder or from onedrive.

2 . Filter not applying after the blank rows and deselecting the blank value in L column , total row is 1K even I have coded to select 50K but not working.

ActiveSheet.Range("$A$2:$J$50000").AutoFilter Field:=10, Criteria1:="<>"

LastRow = .Sheets(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Sheets(2).Range("A3:J" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
.Close savechanges:=False

-----------------------------------------------------------------------------------------------------------------------
code :

Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long
Const strPath As String = "C:\Users\sse106\Downloads\EMP WORK PROFILE\"
ChDir strPath
strExtension = Dir("*.xlsx*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource

Sheets("Activity Survey Template").Select

ActiveSheet.Range("$A$2:$J$50000").AutoFilter Field:=10, Criteria1:="<>"

LastRow = .Sheets(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Sheets(2).Range("A3:J" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
.Close savechanges:=False
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True

Dim ws As Worksheet ' define the sheet you want to work with
Set ws = ThisWorkbook.Worksheets("Output")

' Filter
ActiveSheet.Range("$a$1:$J$1048576").AutoFilter Field:=10, Criteria1:="="


' get filtered data without heading
Dim FilteredRows As Range
On Error Resume Next ' avoid an error message if no rows were filtered
Set FilteredRows = ws.UsedRange.Resize(RowSize:=ws.UsedRange.Rows.Count - 1).Offset(RowOffset:=1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0 ' re-activate error reporting !!!

If Not FilteredRows Is Nothing Then
FilteredRows.EntireRow.Delete
ActiveSheet.AutoFilterMode = False
End If

End Sub
------------------------------------------------------

Data :

Line Manager	Employee ID	Business Segment 2	Region Supporting 3	L1 Ref	L1 Description 4	L2 Description 4	L3 Description 4	L4 Description 4	% of Role 5
aaa	123​		ALL	001	Finance Master Data Management	Maintain Chart of Accounts	Maintain Chart of Accounts	Create Group Account	10​
aaa	124​		ALL	002	Finance Master Data Managemente	Finance Master Data Management	Maintain Chart of Accounts	Create Group Account	10​
aaa	125​		ALL	003	Finance Master Data Management	Finance Master Data Management	Maintain Chart of Accounts	Change Group Account	5​
aaa	126​		ALL	005	Finance Master Data Management	Finance Master Data Management	Maintain Chart of Accounts	Change/ Extend Operational G/L Account new	5​
aaa	127​		ALL	006	Finance Master Data Management	Finance Master Data Management	Maintain Cost & Profit Centres	Create Cost Center	10​
aaa	128​		ALL	007	eeFinance Master Data Managemente	Finance Master Data Management	Maintain Cost & Profit Centres	Create Profit Center	10​