Running a macro across a folder

[AnneOlly]

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[Joel]

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub

 

[AnneOlly]

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[Joel]

I woork on it a little later. What is the differrence between the original
filename and the new filename?

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[AnneOlly]

Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?

I woork on it a little later. What is the differrence between the original
filename and the new filename?

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[Joel]

Try this code. I commented out the four lines to scale and position the
picture you are adding. To get the pixel and size correct I would recommend
recording a macro (Tools - Macro - Record Macro). Then position and size
your logo. Stop record and modify the four lines in the code below as
required.



Sub Orchardcopypaste()

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)

Do While FName <> ""

Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)

With CalendarBk.ActiveSheet

.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With

.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With

FName = Dir()
Loop
End Sub

Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?

I woork on it a little later. What is the differrence between the original
filename and the new filename?

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne



:

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[Joel]

I found a small error

from
With .Range("AW2").Select

to
With .Range("AW2")

Try this code. I commented out the four lines to scale and position the
picture you are adding. To get the pixel and size correct I would recommend
recording a macro (Tools - Macro - Record Macro). Then position and size
your logo. Stop record and modify the four lines in the code below as
required.



Sub Orchardcopypaste()

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)

Do While FName <> ""

Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)

With CalendarBk.ActiveSheet

.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With

.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With

FName = Dir()
Loop
End Sub

Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?

I woork on it a little later. What is the differrence between the original
filename and the new filename?

:

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne



:

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[AnneOlly]

Joel, this is cool thank you so much.

I am getting an run-time error '438' on line 38
..Close

(Object doesn't support this property or method)

Cheers
Anne

I found a small error

from
With .Range("AW2").Select

to
With .Range("AW2")

Try this code. I commented out the four lines to scale and position the
picture you are adding. To get the pixel and size correct I would recommend
recording a macro (Tools - Macro - Record Macro). Then position and size
your logo. Stop record and modify the four lines in the code below as
required.



Sub Orchardcopypaste()

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)

Do While FName <> ""

Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)

With CalendarBk.ActiveSheet

.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With

.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With

FName = Dir()
Loop
End Sub

Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?

:

I woork on it a little later. What is the differrence between the original
filename and the new filename?

:

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne



:

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[AnneOlly]

Hi Joel

Any luck with the error, or is it my inept VBA skills.

Cheers
Anne

Joel, this is cool thank you so much.

I am getting an run-time error '438' on line 38
.Close

(Object doesn't support this property or method)

Cheers
Anne

I found a small error

from
With .Range("AW2").Select

to
With .Range("AW2")

Try this code. I commented out the four lines to scale and position the
picture you are adding. To get the pixel and size correct I would recommend
recording a macro (Tools - Macro - Record Macro). Then position and size
your logo. Stop record and modify the four lines in the code below as
required.



Sub Orchardcopypaste()

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)

Do While FName <> ""

Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)

With CalendarBk.ActiveSheet

.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With

.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With

FName = Dir()
Loop
End Sub


:

Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?

:

I woork on it a little later. What is the differrence between the original
filename and the new filename?

:

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne



:

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[Norman Jones]

Hi AnneOlly,

Try the following minor adaptation of
Joel's code.

I have added variable delarations and
made a minor syntax correction but I
have not otherwise reviewwd thec code.

'============>>
Public Sub Orchardcopypaste()
Dim CalendarBk As Workbook
Dim FindName As String
Dim Fname As Variant
Const sPic As String = _
"H:\My Documents\MyPictures\lincoln.jpg"
Const sHeader As String = "Monthly Management Report"

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
Fname = Dir(Folder & "\" & FindName)

Do While Fname <> ""
Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & Fname)

With CalendarBk
With .ActiveSheet
.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert(sPic)
.Range("AW2").FormulaR1C1 = sHeader
With .Range("AW2")
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
End With
.SaveAs Filename:=Folder & "\Orchard " & Fname
.Close
End With

Fname = Dir()
Loop
End Sub
'<<============


---
Regards.
Norman

Hi Joel

Any luck with the error, or is it my inept VBA skills.

Cheers
Anne

Joel, this is cool thank you so much.

I am getting an run-time error '438' on line 38
.Close

(Object doesn't support this property or method)

Cheers
Anne

I found a small error

from
With .Range("AW2").Select

to
With .Range("AW2")


:

Try this code. I commented out the four lines to scale and position
the
picture you are adding. To get the pixel and size correct I would
recommend
recording a macro (Tools - Macro - Record Macro). Then position and
size
your logo. Stop record and modify the four lines in the code below
as
required.



Sub Orchardcopypaste()

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)

Do While FName <> ""

Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)

With CalendarBk.ActiveSheet

.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse,
msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse,
msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With

.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With

FName = Dir()
Loop
End Sub


:

Erm no difference apart from the fact that I suppose the new
filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to
it?

:

I woork on it a little later. What is the differrence between
the original
filename and the new filename?

:

Thanks Joel, I don't think i was clear before describing the
process:

User:
saves third Party Excel reports one directory c:/orchard from
email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in
this way
each month - I wrote the original macro which 're-brands' one
report with
specified filenames but the 200 reports will all be named
different so I
wanted to make the macro run across all 200 files/reports which
are saved in
a specified folder.

Is this possible? Should I write a macro which combines all
the files in
one file and then run the re-brand macro across the whole file
and then break
the file down into seperate files to send out to each
individual client?

Thanks again for your help
Anne



:

Here is a start to you request. I created a new workbook for
each sheet in
your original workbook and save the newwork book using the
sheet name in the
original workbook. There is a copy statement in your
original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete
the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management
Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name
& ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs
on a specific file
and re-saves it as long as I specify both filenames. I
need to be able to
run this action across multiple reports (up to 200 per
month) and the file
names will be inconsistent. Is there anyway I can run this
macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView -
February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard
header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard
complete2.xls", _
FileFormat:=xlExcel9795, Password:="",
WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[AnneOlly]

Hi all

I fixed the error on .Close and replaced with ActiveWorkbook.Close False, it
seems to work.

Yippeee


Thanks guys for your help/skill/knowledge etc etc

Anne

Hi Joel

Any luck with the error, or is it my inept VBA skills.

Cheers
Anne

Joel, this is cool thank you so much.

I am getting an run-time error '438' on line 38
.Close

(Object doesn't support this property or method)

Cheers
Anne

I found a small error

from
With .Range("AW2").Select

to
With .Range("AW2")


:

Try this code. I commented out the four lines to scale and position the
picture you are adding. To get the pixel and size correct I would recommend
recording a macro (Tools - Macro - Record Macro). Then position and size
your logo. Stop record and modify the four lines in the code below as
required.



Sub Orchardcopypaste()

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)

Do While FName <> ""

Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)

With CalendarBk.ActiveSheet

.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With

.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With

FName = Dir()
Loop
End Sub


:

Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?

:

I woork on it a little later. What is the differrence between the original
filename and the new filename?

:

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne



:

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub

 

[Joel]

You still may need to position and size the logo. Norman removed the 4
commented lines which you may need to add to get the size and position correct

' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

Use the macro record option I specified in earlier posting and change the
number in the code above with the number you delect in the recorded macro.

Hi all

I fixed the error on .Close and replaced with ActiveWorkbook.Close False, it
seems to work.

Yippeee


Thanks guys for your help/skill/knowledge etc etc

Anne

Hi Joel

Any luck with the error, or is it my inept VBA skills.

Cheers
Anne

Joel, this is cool thank you so much.

I am getting an run-time error '438' on line 38
.Close

(Object doesn't support this property or method)

Cheers
Anne


:

I found a small error

from
With .Range("AW2").Select

to
With .Range("AW2")


:

Try this code. I commented out the four lines to scale and position the
picture you are adding. To get the pixel and size correct I would recommend
recording a macro (Tools - Macro - Record Macro). Then position and size
your logo. Stop record and modify the four lines in the code below as
required.



Sub Orchardcopypaste()

Folder = "C:\ORCHARD"
FindName = "CalendarView*.xls"
FName = Dir(Folder & "\" & FindName)

Do While FName <> ""

Set CalendarBk = Workbooks.Open _
(Filename:=Folder & "\" & FName)

With CalendarBk.ActiveSheet

.Rows("1:3").Clear
.Shapes("Picture 75").Delete

Set newpict = .Pictures.Insert("H:\My Documents\My
Pictures\lincoln.jpg")
' newpict.ShapeRange.ScaleWidth 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.ScaleHeight 0.84, msoFalse, msoScaleFromTopLeft
' newpict.ShapeRange.IncrementLeft 209.25
' newpict.ShapeRange.IncrementTop 8.25

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

.Font.Bold = True
.Cut Destination:=Range("AV2")
End With

.SaveAs Filename:=Folder & "\Orchard " & FName
.Close
End With

FName = Dir()
Loop
End Sub


:

Erm no difference apart from the fact that I suppose the new filename has to
indicate that it has been 're-branded' so could we add 'Orchard' to it?

:

I woork on it a little later. What is the differrence between the original
filename and the new filename?

:

Thanks Joel, I don't think i was clear before describing the process:

User:
saves third Party Excel reports one directory c:/orchard from email
Macro:
strips out 'picture 75' which is third party branding
inserts new branding 'orchard header.jpg'
saves new filename
User:
sends new reports to clients

There is over 200 excel reports which need to be manipulated in this way
each month - I wrote the original macro which 're-brands' one report with
specified filenames but the 200 reports will all be named different so I
wanted to make the macro run across all 200 files/reports which are saved in
a specified folder.

Is this possible? Should I write a macro which combines all the files in
one file and then run the re-brand macro across the whole file and then break
the file down into seperate files to send out to each individual client?

Thanks again for your help
Anne



:

Here is a start to you request. I created a new workbook for each sheet in
your original workbook and save the newwork book using the sheet name in the
original workbook. There is a copy statement in your original code that
doesn't get pasted.

I start with a blank workbook so there is no need to delete the old picture
75.

Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Set CalendarBk = Workbooks.Open( _
Filename:="C:\ORCHARD\CalendarView - February - Eureka[1].xls")

For Each sht In CalendarBk.Sheets

Set newbk = Workbooks.Add
With newbk
.Sheets(1).Name = "Report"

.Pictures.Insert ("C:\ORCHARD\orchard header.jpg")

.Range("AW2").FormulaR1C1 = "Monthly Management Report"
With .Range("AW2").Select
With .Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
.Font.Bold = True
.Cut Destination:=Range("AV2")
End With
.SaveAs Filename:="C:\ORCHARD\Orchard\" & sht.Name & ".xls"
.Close
End With
Next sht
End Sub


:

OK, so here's the problem, I have a macro below which runs on a specific file
and re-saves it as long as I specify both filenames. I need to be able to
run this action across multiple reports (up to 200 per month) and the file
names will be inconsistent. Is there anyway I can run this macro across all
sheets in a specified folder?

Thanks guys
Anne





Sub Orchardcopypaste()

ChDir "C:\ORCHARD"
Workbooks.Open Filename:="C:\ORCHARD\CalendarView - February -
Eureka[1].xls"
Rows("1:3").Select
Selection.Clear
ActiveSheet.Shapes("Picture 75").Select
Selection.Delete

Range("A1").Select
Sheets.Add
Sheets("Report").Select
ActiveSheet.Pictures.Insert("C:\ORCHARD\orchard header.jpg").Select

Range("AW2").Select
ActiveCell.FormulaR1C1 = "Monthly Management Report"
Range("U4:BB11").Select
Selection.Copy
Range("AW2").Select
With Selection.Font
.Name = "Arial"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Cut Destination:=Range("AV2")
Range("AV2").Select
ActiveWorkbook.SaveAs Filename:="C:\ORCHARD\Orchard complete2.xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub