ExcelBanter - Repeating the same routine

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Repeating the same routine (https://www.excelbanter.com/excel-programming/415062-repeating-same-routine.html)

Repeating the same routine

Instead of repeating the same code for different file name how can I make
this routine more efficient:
Example
[code contained within command button]

if OptionButton1=true then
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\Store Returns\Data Week1", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("sheet3").Select
ActiveWindow.SelectedSheets.Delete
Windows("Poor Store Returns Ver 3 2003.xls").Activate
Range("B10:C54,H10:J54,L10:N54,P10:R54").Select
Range("P54").Activate
Selection.Copy
Windows("Data Week 1.xls").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("D12").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Range("D7").Select

If OptionButton2=true then
Repeat code for week 2 - 52

any assistance would be much appreciated

Repeating the same routine

Stick to one thread, you have answers in the other thread.

--
__________________________________
HTH

Bob

"leerem" wrote in message
...
Instead of repeating the same code for different file name how can I make
this routine more efficient:
Example
[code contained within command button]

if OptionButton1=true then
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\Store Returns\Data Week1", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("sheet3").Select
ActiveWindow.SelectedSheets.Delete
Windows("Poor Store Returns Ver 3 2003.xls").Activate
Range("B10:C54,H10:J54,L10:N54,P10:R54").Select
Range("P54").Activate
Selection.Copy
Windows("Data Week 1.xls").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("D12").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Range("D7").Select

If OptionButton2=true then
Repeat code for week 2 - 52

any assistance would be much appreciated