PODER SELECCIONAR EL DIRECTORIO DONDE GUARDAR.

Hola!! Muchas Gracias:
tengo esta macro:
para mis efectos trabaja bien pero salva el archivo en C:/ y lo que quisiera
es que al ejecutar la macro aparezca un cuadro de texto para que el usuario
seleccione la carpeta de su agrado donde quiere guardarlo y tambien le pueda
poner el nombre que desee al archivo .
He ntentado varios pero no me sale.
Gracias



Private Sub CONCENTRADO()
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\CONCENTRADO.xls",
FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ThisWorkbook.Activate
Range("C6:F52").Select
Selection.Copy
Windows("CONCENTRADO").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("C6").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ESBLANCO($B6)=VERDADERO"
Selection.FormatConditions(1).Font.ColorIndex = 2
Range("C6").Select
Selection.Copy
Range("C7:C47").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C6").Select
Selection.Copy
Range("A6:A47").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B6").Select

ThisWorkbook.Activate
Range("E5").Select
Selection.Copy
Windows("CONCENTRADO.xls").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C1:C3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D6:D57").Select
Selection.NumberFormat = "0"
Range("B6").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayAlerts = False
ChDir "C:\"
ActiveWorkbook.SaveAs Filename:="C:\CONCENTRADO.xls",
FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
MsgBox " Se ha creado un archivo en C:/ asignele el nombre de la sección y
paselo a la carpeta de su gusto"
ThisWorkbook.Activate
Range("D11").Select
End Sub