Excel VBA - Loop through folder and add certain parts of names to cells in workbook - vba

Question

I'm trying to perform a simple exercise - (1) merge several tabs (each from separate file) into single file ("macro-file"), (2) rename all tabs in accordance with certain cells in these tabs.
Each tab is effectively a bank statement (in different currencies), so all tabs are of the same structure. I've found a macro (I'm not a specialist in VBA, so this is more about "find and adapt" than "write by myself") to merge them all, so there is no problem with step 1.
However, when I'm trying to rename all tabs at once, I'm getting a conflict - there are three tabs relating to Escrow Account and four tabs relating to Ordinary Account, and there is an intersection in currencies between accounts (each account has USD and EUR, for example).
Currently I have the following code to rename the tabs:
Sub RenameSheet ()
Dim rs As Worksheet
For Each rs In Sheets
If rs.Index > 2 Then
rs.Name = rs.Range("D4")
End If
Next rs
End Sub
What I'm looking for is the solution for problem: if file in a given folder (same as the macro-file) contains "ESCROW", then cell value in cell "D4" in the tab merged to macro-file should be changed from "USD" (let it be a USD bank statement) to "Escrow USD".
The macro should be able to check all files in folder (this is Loop, as far as I understand) and rename respectful cells at once.
Here is the example of code I tried to write-down (unsucessfully though):
Sub RenameSheet ()
Dim fName As String, wb As Workbook, rs As Worksheet
For Each rs In Sheets
If rs.Index > 2 Then
Const myPath As String = "C:\Users\my folder"
If Right(myPath, 1) <> "\" Then fPath = myPath & "\"
fName = Dir(fPath & "*Full*.xlsx*")
v = "ESCROW"
Do Until fName <> ""
If InStr(1, fName, v) > 0 Then
rs.Name = "ESCROW" + rs.Range("D4")
Else
rs.Name = rs.Range("D4")
End If
Loop
End If
Next rs
End Sub
If any of you could help me somehow, I will be grateful.
Any questions are welcome (I understand my language can be a bit tricky).
UPDATE. Current code for tabs merging is below (again, that's not mine, only googled it and inserted to my file, works perfectly):
Sub MergeExcelFiles()
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(FileName:=fnameCurFile)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copyafter:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End If
Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub

Answer 1

There are a few things here and there that I changed before getting to the point:
Reordered and renamed some variables for (hopefully) simplicity
Changed the filter on documents to just *.xl* and added a secondary file filter later with Instr(file, ".xl")
Utilized the With statement for changing the Application settings
But, the important new bit comes in during the loop on each sheet in the source workbook. It does the checks that you used in the initial code - checking if index > 2 and whether "ESCROW" is in the filename - then changes the name accordingly via a With statement.
Sub MergeExcelFiles()
Dim fnameList, fnameCurFile As Variant
Dim wbkDestBook, wbkCurSrcBook As Workbook
Dim countFiles, countSheets As Long
Dim wksCurSheet As Worksheet
fnameList = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks (*.xl*),*.xl*", _
Title:="Choose Excel files to merge", _
MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set wbkDestBook = ActiveWorkbook
For Each fnameCurFile In fnameList
If InStr(LCase$(fnameCurFile), ".xl") > 0 Then 'second file filter 'prevents e.g. shortcuts (.html files) that can get this far
Set wbkCurSrcBook = Workbooks.Open(filename:=fnameCurFile)
For Each wksCurSheet In wbkCurSrcBook.Sheets
wksCurSheet.copy after:=wbkDestBook.Sheets(wbkDestBook.Sheets.count)
'renaming here
If wbkDestBook.Sheets.count > 2 Then
With wbkDestBook.Sheets(wbkDestBook.Sheets.count)
If InStr(UCase$(fnameCurFile), "ESCROW") Then
.Name = "ESCROW " & .Range("D4").Value2
Else
.Name = .Range("D4").Value2
End If
End With
End If
'end of renaming
countSheets = countSheets + 1
Next
wbkCurSrcBook.Close SaveChanges:=False
countFiles = countFiles + 1
End If
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Procesed " & countFiles & " files." & vbCrLf & "Merged " & countSheets & " worksheets.", Title:="Merge Excel files"
End If
Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub