Open, Copy & Paste Loop/Rename

[MarkAn]

HI

I am hoping someone can help, I have a very basic macro that opens a file, copies information from a specific tab and pastes it into a master sheet:

Workbooks.Open Filename:= _
"Filepath\Tania.xls" _
, UpdateLinks:=0
Sheets("Caseload").Select
Rows("3:20").Select
Selection.Copy
Windows("Master.xlsm").Activate
Sheets("Tania").Select
Rows("3:3").Select
ActiveSheet.Paste
Range("A3").Select
Windows("Tania.xls").Activate
Application.CutCopyMode = False
ActiveWindow.Close
Range("A4").Select

I have a folder with 10 files in, all with different names I.e. Tania, Paul, Peter, Mary etc.
I have the above macro 10 times so it opens each file in turn and copies the required data from the "Caseload" WorkSheet (this is a constant in all Workbooks) into the Master Workbook onto the corresponding matching WorkSheet.

The names of the files will occasionally change to due team changes, so I have to go in and rename the WorkSheets in the Master file and then also amend the corresponding Macro.

Is there a Macro that I can use that will "loop" the opening of each file in the folder (no matter the file name)? Copy the information from required Worksheet ("Caseload")and paste it into the Master Workbook (however, paste it onto the first Worksheet and then rename that Worksheet with the name of the file it was copied from, and then move onto the next Worksheet until all files have been actioned) (ignoring Worksheets named LMA and Summary in the Master)?

I have tried to see if this is possible from previous posts but having no luck, any help would be greatly appreciated and if any further information is required, please let me know.

Thanks
MarkAn

 

[NdNoviceHlp]

Hi Markan. This seems like it would work. You will need to change the folder path to suit. Please save a back up copy of your wb before testing. HTH. Dave

Private Sub test()
Dim FSO As Object, FolDir As Object, FileNm As Object, sht As Worksheet
Dim WbSheet As String
On Error GoTo ErFix
Set FSO = CreateObject("scripting.filesystemobject")
'*****change folderpath to suit
Set FolDir = FSO.GetFolder(ThisWorkbook.Path & "\Datafiles")
Application.ScreenUpdating = False
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xls" Then
Workbooks.Open FileName:=FileNm
WbSheet = vbNullString
'find sht in thiswb
For Each sht In ThisWorkbook.Worksheets
If LCase(sht.Name) = LCase(FileNm.Name) Then
WbSheet = sht.Name
Exit For
End If
Next sht
If WbSheet = vbNullString Then
With ThisWorkbook
.Sheets.Add(before:=.Sheets(1).Name) = WbSheet
End With
End If
'find data sheet and copy rows to thiswb
For Each sht In Workbooks(FileNm.Name).Worksheets
If LCase(sht.Name) = LCase("CaseLoad") Then
Workbooks(FileNm.Name).Sheets("Caseload").Rows("3:20").Copy _
Destination:=ThisWorkbook.Sheets(WbSheet).Range("A3")
Application.CutCopyMode = False
Application.DisplayAlerts = False
Workbooks(FileNm.Name).Close SaveChanges:=False
Exit For
End If
Next sht
End If
Next FileNm
Application.ScreenUpdating = True
Set FolDir = Nothing
Set FSO = Nothing
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set FSO = Nothing
End Sub

 

[MarkAn]

Hi there, thank you for this code, when I run it, it just brings back the Microsoft Excel Err pop-up and doesnt highlight why.
I've added the filepath of the folder.

 

[MarkAn]

I've just reopened the code and its highlighted/spotlighted this line:

If WbSheet = vbNullString Then

 

[NdNoviceHlp]

Trial 2. Dave

Option Explicit
Private Sub test()
Dim FSO As Object, FolDir As Object, FileNm As Object, sht As Worksheet
Dim Flag As Boolean, NewWS As Worksheet
On Error GoTo ErFix
Set FSO = CreateObject("scripting.filesystemobject")
'*****change folderpath to suit
Set FolDir = FSO.GetFolder(ThisWorkbook.Path & "\Datafiles")
Application.ScreenUpdating = False
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xls" Then
Flag = False
Workbooks.Open FileName:=FileNm
'find sht in thiswb
For Each sht In ThisWorkbook.Worksheets
If LCase(sht.Name) = LCase(Left(FileNm.Name, Len(FileNm.Name) - 4)) Then
Set NewWS = sht
Flag = True
Exit For
End If
Next sht
If Not Flag Then
With ThisWorkbook
Set NewWS = .Sheets.Add(before:=.Worksheets(1))
NewWS.Name = Left(FileNm.Name, Len(FileNm.Name) - 4)
End With
End If
Workbooks(FileNm.Name).Sheets("Caseload").Rows("3:20").Copy _
Destination:=ThisWorkbook.Sheets(NewWS.Name).Range("A3")
Application.CutCopyMode = False
Application.DisplayAlerts = False
Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next FileNm
Application.ScreenUpdating = True
Set FolDir = Nothing
Set FSO = Nothing
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set FSO = Nothing
End Sub

 

[MarkAn]

Hi, thanks for the amendment, it is now opening the file and copying over the information into the Master sheet, however, its not copying it into the WorkSheets that are already in the WorkBook, it's creating new WorkSheets.

The WorkBook I have has x2 Summary Sheets has calculation in for the pre-existing WorkSheets (blanks), so when the macro is run, it would open the files and then copy the requested information into the pre-existing WorkSheets and then rename the WorkSheets to the file name it came from (which worked on the inserted WorkSheets from the 2nd trial code). The WorkSheets named LMA and Summary are ignored but then pre-existing can be overwritten each time the Macro is run.

Is this possible please?

 

[NdNoviceHlp]

Yes anything is possible. My understanding is that you have existing sheet names that are the same as your file names ie. Tania, Paul, Peter, Mary etc. Also, that U want a new sheet created if the file name sheet does not exist. My testing again indicates that this is what the code does. Are you sure that these are .xls files rather than .xlsm or .xlsx files? Please confirm file extension and advise whether my understanding is correct. The information about x2 blank summary sheets that need to be renamed is news to me? What if you have more than 2 files ie. Tania, Paul, Peter, Mary? Dave

 

[MarkAn]

Hi, Sorry probably confused the situation.

My original Workbook had sheets named as: Tania, Paul, Peter, Mary etc. There are also x2 summary sheets named LMA and Summary these need to be ignored as these will compile information from the information sheets.

As team members move teams quite regular at the moment, I was hoping that the files in the folder can be opened, start from the 1st Sheet (irrelevant of the name), copy the information from the first opened file and then rename the tab from the opened file name

There will always be enough sheets to accommodate the number of files in the folder.

Hope this makes sense

 

[NdNoviceHlp]

That's doable but seems like quite a bit of messing around. Firstly does the previous code copy the data to the correct sheet if it exists and if it doesn't does it create a new one? Dave

 

[MarkAn]

I will that in the morning, as I have now finished work (finally) - it definately creates new sheets, will check in the morning if it pastes onto the existing sheets (as I hadnt named them on testing)