Do Until macro that renames workbooks and keeps the original workbook open

[tony_bender]

I need help writing code for the following process:

I have a 'master' workbook consisting of 3 sheets; data, table and pie
chart. In addition I have multiple Excel workbooks, each with 'data'
for a different geography. These 'data' files have the identical
range; A1:Q18. The scenario is 50+ 'data' workbooks open, along with
the 'master' workbook containing the 'report' and 'pie chart'. The
'report' tab is linked to the 'data' sheet, while the 'pie chart' is
linked to the report. I'm trying to write a 'Do Until' macro that
begins with the first 'data' file, copies an exact range from it,
pastes the range onto the 'data' sheet in the 'master' workbook at cell
A1, renames the workbook based on a name in a specific cell of the new
'data'. Then 'saves and closes' the new workbook, and then repeats the
process with the next 'data' workbook.

My problem is once I rename the original 'master' workbook it's closed,
so my Do Until statement stops.

Does anyone have any ideas on how I can write code to make this work.

Thank you,

Tony

 

[Bob Phillips]

This should get you started. Change the ranges to suit

Sub ProcessFiles()
Dim FSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim nTotals As Double
Dim sNewName As String

Set FSO = CreateObject("Scripting.FileSystemObject")

sFolder = "C:\Data"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)

Set Files = Folder.Files
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=file.Path
With ActiveWorkbook
sNewName = .Worksheets("Sheet1").Range("M1").Value
.Worksheets("Sheet1").Range("A1:Q18").Copy _
ThisWorkbook.Worksheets("Sheet1").Range("A1")
.Close savechanges:=False
End With
ThisWorkbook.SaveAs Filename:=sNewName
End If
Next file

End If ' sFolder <> ""

End Sub


--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

 

[tony_bender]

Bob,

Thank you very much...I think this did it...

Thank you

I owe you....