Prompt for filename in excel macro VBA

  • Thread starter Thread starter shamble
  • Start date Start date
S

shamble

Hi Folks,

I'm setting up a basic macro to copy data from one spreadsheet to the
other, the only issue I have is the sheet that the data is being copied
to will have a name that changes on a weekly basis. Is there anyway to
prompt to enter the filename? or any other way around this. My code is
attached below, its the "Windows("060313_hc.xls").Activate" where the
filename will change. Thanks in adavance


Sub UpdateCurrentWeek()
'
' UpdateCurrentWeek Macro
' Updates current week data with information from Mi Central
'

'
Sheets("ASC").Select
ChDir "\\w2k6001\shared\csdgapp\miteam\Manpower"
Workbooks.Open Filename:= _
"\\w2k6001\shared\CSDGAPP\miTeam\Manpower\AManpowerhcv0.2.xls"
Sheets("ASC").Select
Range("D7").Select
ActiveWindow.TabRatio = 0.943
ActiveWindow.SmallScroll ToRight:=5
ActiveWindow.SmallScroll Down:=69
Range("D7:Q106").Select
Selection.Copy
Windows("060313_hc.xls").Activate
Range("D7").Select
ActiveSheet.Paste
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Leeds ASC").Select
Range("D7").Select
ActiveWindow.SmallScroll Down:=57
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
Sheets("Leeds ASC").Select
ActiveWindow.SmallScroll Down:=-12
Range("D7").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("ASC").Select
Range("A1").Select
Sheets("Leicester").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Leicester").Select
ActiveWindow.SmallScroll Down:=-6
Range("D7:T7").Select
ActiveWindow.SmallScroll Down:=84
Range("D7:T95").Select
ActiveWindow.SmallScroll Down:=-21
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
Range("D7").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Oldbury").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Oldbury").Select
ActiveWindow.SmallScroll Down:=-9
Range("D7").Select
ActiveWindow.SmallScroll ToRight:=4
ActiveWindow.SmallScroll Down:=81
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
ActiveWindow.SmallScroll Down:=-12
Range("D7").Select
ActiveSheet.Paste
Range("A1").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Stockport").Select
Range("D7").Select
ActiveWindow.SmallScroll ToRight:=5
ActiveWindow.SmallScroll Down:=66
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
ActiveWindow.SmallScroll Down:=-21
Sheets("Stockport").Select
Range("D7").Select
ActiveSheet.Paste
Sheets("Uddingston").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Uddingston").Select
Range("D7").Select
ActiveWindow.SmallScroll ToRight:=4
ActiveWindow.SmallScroll Down:=72
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
Range("D7").Select
ActiveSheet.Paste
Windows("AManpowerhcv0.2.xls").Activate
ActiveWindow.Close
Range("A1").Select
Sheets("ASC").Select
Range("A1").Select
End Sub
 
filename = InputBox("Enter file name")

HTH
--
AP
Hi Folks,

I'm setting up a basic macro to copy data from one spreadsheet to the
other, the only issue I have is the sheet that the data is being copied
to will have a name that changes on a weekly basis. Is there anyway to
prompt to enter the filename? or any other way around this. My code is
attached below, its the "Windows("060313_hc.xls").Activate" where the
filename will change. Thanks in adavance


Sub UpdateCurrentWeek()
'
' UpdateCurrentWeek Macro
' Updates current week data with information from Mi Central
'

'
Sheets("ASC").Select
ChDir "\\w2k6001\shared\csdgapp\miteam\Manpower"
Workbooks.Open Filename:= _
"\\w2k6001\shared\CSDGAPP\miTeam\Manpower\AManpowerhcv0.2.xls"
Sheets("ASC").Select
Range("D7").Select
ActiveWindow.TabRatio = 0.943
ActiveWindow.SmallScroll ToRight:=5
ActiveWindow.SmallScroll Down:=69
Range("D7:Q106").Select
Selection.Copy
Windows("060313_hc.xls").Activate
Range("D7").Select
ActiveSheet.Paste
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Leeds ASC").Select
Range("D7").Select
ActiveWindow.SmallScroll Down:=57
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
Sheets("Leeds ASC").Select
ActiveWindow.SmallScroll Down:=-12
Range("D7").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("ASC").Select
Range("A1").Select
Sheets("Leicester").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Leicester").Select
ActiveWindow.SmallScroll Down:=-6
Range("D7:T7").Select
ActiveWindow.SmallScroll Down:=84
Range("D7:T95").Select
ActiveWindow.SmallScroll Down:=-21
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
Range("D7").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Oldbury").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Oldbury").Select
ActiveWindow.SmallScroll Down:=-9
Range("D7").Select
ActiveWindow.SmallScroll ToRight:=4
ActiveWindow.SmallScroll Down:=81
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
ActiveWindow.SmallScroll Down:=-12
Range("D7").Select
ActiveSheet.Paste
Range("A1").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Stockport").Select
Range("D7").Select
ActiveWindow.SmallScroll ToRight:=5
ActiveWindow.SmallScroll Down:=66
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
ActiveWindow.SmallScroll Down:=-21
Sheets("Stockport").Select
Range("D7").Select
ActiveSheet.Paste
Sheets("Uddingston").Select
Windows("AManpowerhcv0.2.xls").Activate
Sheets("Uddingston").Select
Range("D7").Select
ActiveWindow.SmallScroll ToRight:=4
ActiveWindow.SmallScroll Down:=72
Range("D7:T95").Select
Application.CutCopyMode = False
Selection.Copy
Windows("060313_hc.xls").Activate
Range("D7").Select
ActiveSheet.Paste
Windows("AManpowerhcv0.2.xls").Activate
ActiveWindow.Close
Range("A1").Select
Sheets("ASC").Select
Range("A1").Select
End Sub
Click to expand...
 
I would use the GetOpenFilename method, See VBA help.

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
Sorry guys, I'm a bit thick when it comes to things like this, what
code would i insert into the part with <<<<<< next to it as i'm
assuming this is the part i need to change, thanks:

Sheets("ASC").Select
ChDir "\\w2k6001\shared\csdgapp\miteam\Manpower"
Workbooks.Open Filename:= _
"\\w2k6001\shared\CSDGAPP\miTeam\Manpower\AManpowerhcv0.2.xls"
Sheets("ASC").Select
Range("D7").Select
ActiveWindow.TabRatio = 0.943
ActiveWindow.SmallScroll ToRight:=5
ActiveWindow.SmallScroll Down:=69
Range("D7:Q106").Select
Selection.Copy
Windows("060313_hc.xls").Activate <<<<<<<<<<<
Range("D7").Select
ActiveSheet.Paste
 
put this after the selection.copy statement

filename = Application.GetOpenFilename("Excel files (*.xls), *.xls")
Windows(filename).Activate

this will prompt the user to select an excel file from the Open file
dialog box and activate whichever file the user selects
 
kdp145 said:
put this after the selection.copy statement

filename = Application.GetOpenFilename("Excel files (*.xls), *.xls")
Windows(filename).Activate

this will prompt the user to select an excel file from the Open file
dialog box and activate whichever file the user selects
Click to expand...

ahh, now thats looking like what i want, only problem is its giving an
error after i open the file i want. "Run-time error'9';
Subscript out of range"

Any ideas? thanks in advance
 
That is not correct, GetOpenFilename doesn't open the file, it just returns
the selected file name.

You need

Dim sFilename as string

sFilename = Application.GetOpenFilename("Excel files (*.xls), *.xls")
If sFilename <> "" Then
Workbooks.Open sFilename
End If

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
Back
Top