Capture multiple sourcefile filenames

[Guest]

Hi, I have code (that I got plenty of help with from here) that loops through
and opens chosen excel files and copies the contents of each one to my
basebook, one after the other , starting each successive paste on the next
blank line after the previous paste.

But later on, looking at the basebook, if I see an error in data, I would
like to know which file that line of data came from.

The data in each source file is formatted the same, taking up several
columns. Is there a way to insert the filename of the source book into the
cell in column AA (as text, not as a formula) for every row (or at least the
first row) that is copied from each book?

Thank you!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Sling\taiwan\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. " _
& "But, it should be done within FIVE MINUTES. " & vbNewLine &
vbNewLine _
& "So, I'll meet you right back here, at about " & Format(DateAdd("n",
5, Now), "medium time") & ", ok? " & vbNewLine & vbNewLine _
& "Be sure to click OK before you go!"


If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Cells(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Cells(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

 

[Guest]

Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destname1 = basebook.Worksheets(1).Range("AA" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)
Set destname2 = basebook.Worksheets(2).Range("AA" & rnum2)

sourceRange1.Copy destrange1
destrange1.value = MyFiles(Fnum)
sourceRange2.Copy destrange2
destrange2.value = MyFiles(Fnum)