Sub WorkbookOpen()
On Error Resume Next
Application.ScreenUpdating = False
aps = Application.PathSeparator
wb = ThisWorkbook.Path
wb0 = ThisWorkbook.Name
Wb1 = "ap.xls"
Wb2 = "PL.xlsx"
Workbooks.Open (wb & aps & Wb1)
Wb1 = ActiveWorkbook.Name
If Err.Number <> 0 Then
MsgBox Err.Description
Exit Sub
End If
Workbooks.Open (wb & aps & Wb2)
Wb2 = ActiveWorkbook.Name
If Err.Number <> 0 Then
MsgBox Err.Description
Exit Sub
End If
ALL_SAME = True
e = 2
Do
chk_e = Workbooks(Wb1).Sheets(1).Cells(e, "E")
chk_y = Workbooks(Wb1).Sheets(1).Cells(e, "Y")
a = WorksheetFunction.Match(chk_e, Workbooks(Wb2).Sheets(1).Range("A:A"), 0)
If Err.Number = 0 Then
With Workbooks(Wb2).Sheets(1)
x = .Cells(a, .Columns.Count).End(xlToLeft).Column + 1
If x < 3 Then x = 3
.Cells(a, x) = chk_y
If .Cells(a, x) <> .Cells(a, x - 1) Then ALL_SAME = False
End With
bg = xlNone
Else
bg = 6
Err.Clear
End If
Workbooks(Wb1).Sheets(1).Cells(e, "E").Interior.ColorIndex = bg
e = e + 1
Loop Until Workbooks(Wb1).Sheets(1).Cells(e, "E") = Empty
End Sub
The code is perfect only i am unable to write the code to save and close all the workbooks (i have to save and close ap.xls and pl.xlsx in the last stage of the code so plz help)