match sheet names

[Chad]

Hi All

I am having trouble with this and wanted some assistance. I am trying
to build a consolidation of P&L sheets held in different files. I am
able to dynamically open all the P&L files fine.

I just want to match the sheet names in the opened files with that of
the consolidation sheet names. So in the opened file, for example a
sheet called “MP+L” exists so copy it (values only). Match this sheet
name in the consolidation file, paste this data right over the top of
the old data (no links).

This is possible it is just getting late here in Oz and I am tired.

Thanks in advance for your help.

Chad

Code works however without the dynamism of matching sheet names
between consolidation and all children worksheets.

Option Explicit
Sub OpenandPaste()
Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
Dim ws As Worksheet
Dim varSh As String
Dim twbk As Workbook
Dim lw As Integer

Set twbk = ActiveWorkbook

Application.ScreenUpdating = False
sPath = "C:\users\smallman\excel" 'location of files
ChDir sPath
sFil = Dir("Open*.xls") 'change or add formats
Do While sFil <> "" 'will start LOOP until all files in folder sPath
have been looped through
Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file
varSh = "P+L" 'NEED a variable here to cope with the changing file
names.
' do something
For Each ws In ActiveWorkbook.Worksheets
If Right(LCase(ws.Name), 1) = "1" Then '1 just used as a test to see
that sheet1 would copy in OK
lw = ws.Range("B" & Rows.Count).End(xlUp).Row
ws.Range("B6:S" & lw).Copy twbk.Sheets(varSh).Range("B6")
End If
Next ws
oWbk.Close False 'close the workbook, NOT saving changes
sFil = Dir
Loop ' End of LOOP
End Sub

 

[john]

very much not tested but see if this approach gives you some ideas

Option Explicit
Sub OpenandPaste()
Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
Dim ws As Worksheet
Dim sh As Worksheet


Dim twbk As Workbook
Dim lw As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set twbk = ThisWorkbook

'location of files
sPath = "C:\users\smallman\excel"

ChDir sPath

sFil = Dir("Open*.xls") 'change or add formats


On Error GoTo ExitProg

'Step Thru each worksheet
'in activeworkbook
For Each sh In twbk.Worksheets

'LOOP through all files
'in folder sPath
Do While sFil <> ""

'opens the file read only
Set oWbk = Workbooks.Open(sPath & "\" & sFil, ReadOnly:=True)

'step thru each sheet to see if one
'matches with active sheet
For Each ws In oWbk.Worksheets

If LCase(ws.Name) = LCase(sh.Name) Then

'remove existing data
'from activesheet
lw = sh.Range("B" & sh.Rows.Count).End(xlUp).Row

If lw > 5 Then sh.Range("B6:S" & lw).ClearContents

'copy worksheet
lw = ws.Range("B" & ws.Rows.Count).End(xlUp).Row

If lw > 5 Then ws.Range("B6:S" & lw).Copy sh.Range("B6")

Exit For

End If

Next ws

'close the workbook,
'NOT saving changes
oWbk.Close False

sFil = Dir

Set oWbk = Nothing

' End of LOOP
Loop

Next sh

Set twbk = Nothing

ExitProg:

If Err > 0 Then

MsgBox (Error(Err))
Err.Clear

End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub