Private Sub Excel3rd_as_Generator() Dim A As String Dim B1 As Workbook, B2 As Workbook Dim C As String 'PATH REPORT TO PASTE' 'A = "C:\Users\phareh\Desktop\x.xlsm"' A = ThisWorkbook.Worksheets("SRM_BAL_R2018_AR").Range("H4").Value 'PATH DATA REPORT TO COPY' 'A = "C:\Users\phareh\Download\y.xlsm"' C = ThisWorkbook.Worksheets("SRM_BAL_R2018_AR").Range("E4").Value Application.ScreenUpdating = False Application.DisplayAlerts = False Application.AskToUpdateLinks = False Application.EnableEvents = False On Error Resume Next Set B1 = Application.Workbooks.Open(A) 'IF DATA EMPTY THEN PASTE' If B1.Sheets(1).Range("A2") = "" Then Set B2 = Application.Workbooks.Open(C) B.Activate Rows("6:6").Select 'CREATE FILTER' Selection.AutoFilter ActiveSheet.Range("A6:O6").AutoFilter Field:=5, Criteria1:="SRM" B.Sheets(1).Range("A6:O6").Select Range(Selection, Selection.End(xlDown)).Copy B1.Sheets("R2018 (AR)").Range("A1").PasteSpecial B2.Close False B1.Close SaveChanges:=True 'IF DATA EXIST THEN PASTE' Else Set B2 = Application.Workbooks.Open(C) B.Activate Rows("6:6").Select 'CREATE FILTER' Selection.AutoFilter ActiveSheet.Range("A6:O6").AutoFilter Field:=5, Criteria1:="SRM" B.Sheets(1).Range("A6:O6").Select Range(Selection, Selection.End(xlDown)).Copy B1.Sheets("R2018 (AR)").Activate Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial B2.Close False B1.Close SaveChanges:=True End If On Error GoTo 0 Application.ScreenUpdating = True Application.DisplayAlerts = True Application.AskToUpdateLinks = True Application.EnableEvents = True End Sub
Preview:
downloadDownload PNG
downloadDownload JPEG
downloadDownload SVG
Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!
Click to optimize width for Twitter