Hello all,
I have the below code which combines files in a designated folder. I would like to have excel prompt the user to browse to the folder where the files are, rather than have the folder path hard coded. I have tried various ways but cannot get it to work. Can anyone assist? I would like to accomplish this without dramatically altering my exisiting code...since it otherwise works great. Thanks!
Sub Consolidate()
' This macro imports (combines) all TSR workbooks into one sheet.
' This defines various objects
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet
Dim LR As Long, NR As Long
' This speeds up the macro.
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
' This defines that the current workbook is the detination for all the TSR workbooks to be copied too.
Set wbkNew = ThisWorkbook
wbkNew.Activate
Sheets("Master").Activate
' This defines the range of each TSR workbook to be copied.
NR = Range("A8:BP27").End(xlUp).Row + 1
' This sets the path of the folder where the TSR workbooks to be imported are stored.
OldDir = CurDir
fPath = "C:\Documents and Settings\christopher.kline\Desktop\Work Files\Projects\Pending\Automated TSR Process\New TSR Template\TSR Combine Tests\Test A (5 Workbooks)"
ChDir fPath
fName = Dir("*.xl*")
' This imports the first sheet from each TSR workbook in the folder.
Do While Len(fName) > 0
Set wbkOld = Workbooks.Open(fName)
Sheets(1).Activate
' This imports only rows where column BO is not blank.
LR = Range("BO" & Rows.Count).End(xlUp).Row
' This copies only the given range of data from each TSR.
Range("A8:BP27").Copy
' This pastesvalues in column A of the destination workbook.
wbkNew.Sheets("Master").Range("A" & NR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' This closes the TSR workbooks and moves on to the next TSR workbook and the next empty row in the destination workbook.
wbkOld.Close False
NR = Range("A" & Rows.Count).End(xlUp).Row + 1
fName = Dir
Loop
' This resets the settings we changed to speed up the macro.
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
' This restores the original working path.
ChDir OldDir
End Sub
Bookmarks