Hi Les,
Try replacing your code with the following
version:
'===========>
Option Explicit
'-------------->>
Private Sub RenameFiles()
Dim WB As Workbook
Dim oFSO As Object
Dim oFolder As Object
Dim ofile As Object
Dim oFiles As Object
Dim sPath As String
Dim sName As String
Dim iLen As Long
Dim sStr As String
Dim sNewName As String
Dim sOldName As String
Dim sSheet As String '<<===== CHANGE
Const sCell As String = "A1" '<<===== CHANGE
Const sExt As String = ".xls" '<<===== CHANGE
sPath = "C:\Users\Norman\" _
& "Documents\Test" '<<===== CHANGE
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files
iLen = Len(sExt)
On Error GoTo XIT
Application.ScreenUpdating = False
For Each ofile In oFiles
With ofile
sName = .Name
If UCase(Right(sName, iLen)) = UCase(sExt) Then
sOldName = .path
Set WB = Workbooks.Open(Filename:=sOldName)
With WB
sStr = .Sheets(1).Range(sCell).Value
.Close SaveChanges:=False
End With
sNewName = Replace(sOldName, .Name, sStr & sExt)
Name sOldName As sNewName
End If
End With
Next ofile
XIT:
Set oFiles = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
Application.ScreenUpdating = True
End Sub
'<===========
---
Regards.
Norman
Les said:
Hi Norman, as per my last msg, there are definately values in A1 and the
sheets are not named Sheet1.
They one book's sheet 1 is named "Hauptseite-1" and the other is named
"Liste Befund-1".
These are all the worksheets(1)
