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