Hi, I wonder whether someone may be able to help me please.
I'm using the script below to allow a user to open multiple files, extracting a range of information before pasting this into a "Summary" sheet.
Sub MergeOriginal()
Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
StartRow = 2
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select the workbooks to merge.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
Exit Sub
End If
End If
For n = LBound(FileNames) To UBound(FileNames)
Set WB = Workbooks.Open(Filename:=FileNames(n), ReadOnly:=True)
For Each WS In WB.Worksheets
If WS.Name = SourceSheet Then
With WS
If .UsedRange.Cells.Count > 1 Then
dr = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.Count).End(xlUp).Row + 1
If dr < 5 Then dr = 6 'destination start row
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
If LastRow >= StartRow Then
.Range("A" & StartRow & ":M" & LastRow).Copy
DestWB.Worksheets("Time Recording").Cells(dr, "B").PasteSpecial xlValues
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
End If
End If
End With
Exit For
End If
Next WS
WB.Close savechanges:=False
Next n
End Sub
In it's current for, the user has to select each file to open, but I'd like to adapt this so the user only has to select the folder and the files open automatically and extract the data, but I'm very unsure about how to do this.
I just wondered whether someone could possibly look at this and offer some guidance on how I may go about amending this.
Many thanks and kind regards
Bookmarks