Code: Select all
Sub STEP7()
On Error Resume Next
Application.ScreenUpdating = False
aps = Application.PathSeparator 'i have to keep this line or not
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 = 0
e = e + 1
Loop Until Workbooks(Wb1).Sheets(1).Cells(e, "E") = Empty
Workbooks(Wb1).Close True
Workbooks(Wb2).Close True
End Sub
I need to mention the path of all the files & May i know what changes are requierd in this macro?