Change My Macro to Prompt User to Select Folder

[bac]

Presently it opens a specific folder, and pulls sheet 9 of all
spreadsheets into a new spreadsheet called Master 1. I would like for
the user to select the folder, rather than having a specific path
identified in the macro.

This is the Macro I would like to change.
Sub Combine()


Fpath = "C:\home\xxxxxxxxxxxxx\xxxxxxxx\4010\" ' change to suit
your directory
fName = Dir(Fpath & "*.xls")

Do While fName <> ""
Workbooks.Open Fpath & fName
Sheets(9).Copy
after:=Workbooks("Master1.xls").Sheets(Workbooks("Master1.xls").Sheets.Count)
Workbooks(fName).Close savechanges:=False
fName = Dir
Loop

End Sub


I'll really appreciate any help with problem!
thanks

 

[Mark Ivey]

Give this a go...

Sub Combine()
Dim Fpath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then Exit Sub
Fpath = .SelectedItems(1)
End With

fName = Dir(Fpath & "*.xls")

Do While fName <> ""
Workbooks.Open Fpath & fName
Sheets(9).Copy
after:=Workbooks("Master1.xls").Sheets(Workbooks("Master1.xls").Sheets.Count) Workbooks(fName).Close savechanges:=False fName = Dir Loop End Sub"bac" <[email protected]> wrote in messagePresently it opens a specific folder, and pulls sheet 9 of all> spreadsheets into a new spreadsheet called Master 1. I would like for> the user to select the folder, rather than having a specific path> identified in the macro.>> This is the Macro I would like to change.> Sub Combine()>>> Fpath = "C:\home\xxxxxxxxxxxxx\xxxxxxxx\4010\" ' change to suit> your directory> fName = Dir(Fpath & "*.xls")>> Do While fName <> ""> Workbooks.Open Fpath & fName> Sheets(9).Copy>after:=Workbooks("Master1.xls").Sheets(Workbooks("Master1.xls").Sheets.Count)> Workbooks(fName).Close savechanges:=False> fName = Dir> Loop>> End Sub>>> I'll really appreciate any help with problem!> thanks>

 

[Mark Ivey]

Some of the wrong text got connected with the paste...

Give this one a try...


Sub Combine()
Dim Fpath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then Exit Sub
Fpath = .SelectedItems(1)
End With
fName = Dir(Fpath & "*.xls")

Do While fName <> ""
Workbooks.Open Fpath & fName
Sheets(9).Copy
after:=Workbooks("Master1.xls").Sheets(Workbooks("Master1.xls").Sheets.Count)
Workbooks(fName).Close savechanges:=False
fName = Dir
Loop

End Sub

 

[bac]

Mark,

Thanks for getting me started. I've tried your suggestion.
I'm being prompted to select folder, but it does not proceed to copy
sheet(9) from all spreadsheets.
Any idea why?
Thanks, BAC

 

[bac]

Mark,
Still having challenges! Any other ideas?
Thanks
bac

 

[Bob Phillips]

Sub Combine()
Dim Fpath As String
Dim Fname As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then Exit Sub
Fpath = .SelectedItems(1)
End With
Fname = Dir(Fpath & "\*.xls")

Do While Fname <> ""
Workbooks.Open Fpath & Fname
Sheets(9).Copy after:=Workbooks("Master1.xls") _
.Sheets(Workbooks("Master1.xls").Sheets.Count)
Workbooks(Fname).Close savechanges:=False
Fname = Dir
Loop

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Chris Lewis]

Sub Combine()
Dim Fpath As String
Dim Fname As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then Exit Sub
Fpath = .SelectedItems(1)
End With
Fname = Dir(Fpath & "\*.xls")

Do While Fname <> ""
Workbooks.Open Fpath & Fname
Sheets(9).Copy after:=Workbooks("Master1.xls") _
.Sheets(Workbooks("Master1.xls").Sheets.Count)
Workbooks(Fname).Close savechanges:=False
Fname = Dir
Loop

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

It is because you add the slash in the Fname = Dir(Fpath & "\*.xls") line
but dont add the required slash in the Workbooks.Open line. Change the
Woorkbooks.Open as below and it should work.


Sub Combine()
Dim Fpath As String
Dim Fname As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then Exit Sub
Fpath = .SelectedItems(1)
End With
Fname = Dir(Fpath & "\*.xls")

Do While Fname <> ""
Workbooks.Open Fpath & "\" & Fname
Sheets(9).Copy after:=Workbooks("Master1.xls") _
.Sheets(Workbooks("Master1.xls").Sheets.Count)
Workbooks(Fname).Close savechanges:=False
Fname = Dir
Loop

End Sub

 

[bac]

Chris, Bob & Mark,

You are the Bomb! Thanks Chris for noticing the missing \. It works
GREAT! Just what I was looking for.

THANK YOU GUYS!

 

[Chris Lewis]

Chris, Bob & Mark,

You are the Bomb! Thanks Chris for noticing the missing \. It works
GREAT! Just what I was looking for.

THANK YOU GUYS!

For short bits of code like this you can step through the code line by line
by pressing F8 when in the VBA editor window. If you have the Locals
Windows displayed (View | Locals Window in the VBA editor) you can watch the
value of each variable to check they are being assigned the value you expect
at that point.

I find it invaluable for both finding errors and also trying to understand
others code that I am struggling with.