Hello,
I've just wrote this code with my knowledge (basic) in excel and vba and some parts of code found on the internet.
It is working fine, however could you please help me to optimize that code ?
Thanks a lot,
Greg
I've just wrote this code with my knowledge (basic) in excel and vba and some parts of code found on the internet.
It is working fine, however could you please help me to optimize that code ?
Thanks a lot,
Greg
Code:
Sub ClientX()
varMonth = Range("J13").Value
varClientSheet = "Client X"
Set wbCodeBook = ThisWorkbook
varMacro = ActiveWorkbook.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = "T:\Operations\Files\Client X\" & varMonth & "\"
.FileType = msoFileTypeExcelWorkbooks
.Filename = "*Email 1.xls"
.SearchSubFolders = True
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count ' Loop through all.
'Open Workbook and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
varFilePath = ActiveWorkbook.path
Range("A5:Y30").Copy
Windows(varMacro).Activate
Sheets(varClientSheet).Select
Range("F2").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Offset(0, -2).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Cellules = ActiveSheet.Range("D:D")
Range("A1").Value = Application.WorksheetFunction.Max(Cellules)
Range("F2").Select
Selection.CurrentRegion.Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Sheets("Menu").Select
Range("A1").Select
Cells.Find(What:="Client X", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Offset(2, 3).Value = varFilePath
ActiveCell.Offset(0, 3).Select
ActiveCell.Offset(1, 0).Value = Now()
MsgBox "Done!"