Save multiple files into selected folder using file dialog folder picker

[selvendran]

Hi all

I need your expertise in modifying/tweaking a little bit in the below mentioned code to make it work in a better way.

[TABLE="width: 54"]
<tbody>[TR]
[TD="class: xl63, width: 72, bgcolor: transparent"]For Each
myCell In TheRange
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]If Trim(myCell) <>
"" Then
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Sheets("Cover").Cells(myCell.Row,
66).Copy
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Range("M31").Select
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Selection.PasteSpecial Paste:=xlPasteValues
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Call ComboBox1_Change
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Application.StatusBar =
"Processing: " & myCell & " FC Template......."
& "Please Wait !!!"
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Calculate
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]'*******************CREATING
NEW XL WORKSHEET & COPYING DATA**************************
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Dim fd As FileDialog
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Dim TempPath As String
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Dim myFolder As Variant
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]ExtraSlash = "\"
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Set fd =
Application.FileDialog(msoFileDialogFolderPicker)
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]With fd
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"].AllowMultiSelect = False
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]If .Show = -1 Then
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]For Each myFolder In
.SelectedItems
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]TempPath = myFolder &
ExtraSlash
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]ActiveWorkbook.SaveCopyAs
Filename:=TempPath & myCell & ".xlsm"
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Next myFolder
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]End If
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]End With
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Set fd = Nothing
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]End If
[/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl63, bgcolor: transparent"]Next myCell
[/TD]
[/TR]
</tbody>[/TABLE]

 

[selvendran]

This thread has been updated and moved to new post. Please look into this and provide solution.

http://www.mrexcel.com/forum/excel-...cted-folder-using-filedialogfolderpicker.html