Import Multiple Closed Worksheets to Central Worksheet - excel

I'm attempting to create a centralized database that imports the same tab (named "Import") from multiple workbooks into a tab on a different workbook.
I am new to VBA, and modifying code from VBA Import multiple sheets into Workbook and https://danwagner.co/how-to-combine-data-from-multiple-sheets-into-a-single-sheet/.
Only the data from the open file is imported into the database worksheet. I would like all the selected files' "Import" tabs to be brought in. Additionally, I'd like to not open any of the source files.
Sub InsertDatabase()
Dim FileNames As Variant 'Group of files to be looped through
Dim FileName As Variant 'Country of focus (file open)
Dim ActiveCountryWB As Workbook 'Active workbook of country
Dim wksSrcCountry As Worksheet 'Import worksheet in country
Dim wksDstDatabase As Worksheet 'Data worksheet in database
Dim rngSrcCountry As Range 'Range of data in import worksheet
Dim rngDstDatabase As Range 'Range of data in data worksheet in database
Dim lngSrcLastRow As Long
Dim lngDstLastRow As Long
'Set destination reference
Set wksDstDatabase = ThisWorkbook.Worksheets(1)
MsgBox "In the following browser, please choose the Excel file(s) you want to copy data from"
FileNames = Application.GetOpenFilename _
(Title:="Please choose the files you want to copy data FROM", _
FileFilter:="All Files (*.*),*.*", _
MultiSelect:=True)
If VarType(CountriesGroup) = vbBoolean Then
If Not CountriesGroup Then Exit Sub
End If
'Set initial destination range
lngDstLastRow = LastOccupiedRowNum(wksDstDatabase)
Set rngDstDatabase = wksDstDatabase.Cells(lngDstLastRow + 1, 1)
'Loop over all files selected by user, and import the desired "Import" sheet
For Each FileName In FileNames
'Set country workbook references
Set ActiveCountryWB = Workbooks.Open(FileName)
Set wksSrcCountry = ActiveCountryWB.Sheets("Import")
'Identify last occupied row on import sheet
lngSrcLastRow = LastOccupiedRowNum(wksSrcCountry)
'Store source data
With wksSrcCountry
Set rngSrcCountry = .Range(.Cells(1, 1), .Cells(lngSrcLastRow, 20))
rngSrcCountry.Copy Destination:=rngDstDatabase
End With
'Redefine destination range now that new data has been added
lngDstLastRow = LastOccupiedRowNum(wksDstDatabase)
Set rngDstDatabase = wksDstDatabase.Cells(lngDstLawRow + 1, 1)
Next FileName
End Sub
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function

The code you pulled online is honestly poorly put together. You do not need a function to determine the last row (as seen below). I would try this instead (clear your code out of the excel). The macro should follow the below steps:
1) Prompt user to select import files
2) Copy the data form "Import" sheet from Col A - T (down to last row) into your Database
3) Close the Import Book
4) Loop steps 2 & 3 until all Import books are covered
-Paste this code in a module
-Create a new sheet called "Data" (make sure it has headers or this will error out)
-If your Import sheets have headers you need to change the copy range from A1 to A2 (otherwise you will keep importing headers in the middle of your data)
Sub Database()
Dim CurrentBook As Workbook 'Import books
Dim ImportFiles As FileDialog
Dim FileCount As Long 'Count of Import books selected
Dim Database As Worksheet
Set Database = ThisWorkbook.Sheets("Data")
'Open File Picker
Set ImportFiles = Application.FileDialog(msoFileDialogOpen)
With ImportFiles
.AllowMultiSelect = True
.Title = "Pick import files"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
'Stop Alerts/Screen Updating
Application.DisplayAlerts = False
Application.DisplayAlerts = False
'Move Data from ImportBook(s) to Database
For FileCount = 1 To ImportFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
'Determine Last Row on Import Book
Dim ImportLRow As Long
ImportLRow = CurrentBook.Sheets("Import").Range("A" & CurrentBook.Sheets("Import").Rows.Count).End(xlUp).Row
'Determine Last Row on Database Book
Dim DatabaseLRow As Long
DatabaseLRow = Database.Range("A" & Database.Rows.Count).End(xlUp).Offset(1).Row
'Copy Range
Dim CopyRange As Range
Set CopyRange = CurrentBook.Sheets("Import").Range("A1:T" & ImportLRow) 'If the sheets have headers, change this from A1 to A2
CopyRange.Copy
'Paste Range
Database.Range("A" & DatabaseLRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
'Close Import Book (Do not save)
CurrentBook.Close False
Next FileIdx
'Enable Alerts/Screen Updating
Application.DisplayAlerts = True
Application.DisplayAlerts = True
End Sub

Related

Trouble with Set active cell value - Runtime 438

I'm creating a script to import data from a series of Workbooks in a declared folder.
The Workbook may contain multiple sheets as dictated by the values on the "DD Meeting" tab, whereby if the cell value begins with "Code_", there will be no sheet to import from.
I'm trying to create a script that looks for a sheet name based on these values, copies the data, then looks for the next sheet to resume the copy job.
I can copy from the first sheet fine, however the script then has trouble searching for the next sheet name using an activecell instead of the declaring a specific cell (I need to offset hence can't name the cell).
This works:
Set wsData = wb.Sheets(Worksheets("DD Meeting").Range("D6").Value)
This doesnt:
Set wsData = wb.Sheets(Worksheets("DD Meeting").ActiveCell.Value)
Any help is appreciated, thanks.
Sub ImportInfo()
Dim sPath As String 'path of folder containing info
Dim sFileName As String '
Dim wsSummary As Worksheet 'worksheet to paste data to in this workbook
Dim wsData As Worksheet 'sheet with data to copy
Dim wb As Workbook 'workbooks to loop thorugh
Dim nr As Long 'next row to add the data
'Get the worksheet to add the info to
Set wsSummary = ThisWorkbook.Worksheets("Sheet1")
'first row is 2
nr = 2
sPath = "C:\Users\sthorley\Downloads\Test\" '[COLOR=#ff0000][B]Change as required[/B][/COLOR]
sFileName = Dir(sPath & "*.xlsm")
Do While sFileName <> ""
'open workbook
Set wb = Workbooks.Open(Filename:=sPath & sFileName, ReadOnly:=True)
wb.Sheets(Worksheets("DD Meeting").Range("D6").Value).Activate
'get the sheet to copy from
Set wsData = wb.Sheets(Worksheets("DD Meeting").Range("D6").Value)
Worksheets("DD Meeting").Select
Worksheets("DD Meeting").Range("D6").Select
'get the data
Do While ActiveCell.Value <> "*Code*"
wsSummary.Range("A" & nr).Value = wsData.Range("B5").Value
wsSummary.Range("B" & nr).Value = wsData.Range("B3").Value
wsSummary.Range("C" & nr).Value = sFileName
wsData.Activate
wsData.Range("A5").Select
' Summary Key Points
wsData.Cells.Find(What:="Summary/Key points", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
, MatchCase:=False, SearchFormat:=False).Activate
wsSummary.Range("D" & nr).Value = ActiveCell.Offset(2).Value
'get next row
nr = nr + 1
Worksheets("DD Meeting").Select
ActiveCell.Offset(1).Select
'get the sheet to copy from
Set wsData = Nothing
Set wsData = wb.Sheets(Worksheets("DD Meeting").ActiveCell.Value)
Loop
'close the workbook
wb.Close savechanges:=False
'get next workbook name
sFileName = Dir
Loop
End Sub

Copy whole column from closed workbook into open workbook

I am trying to copy data from a closed workbook into an open workbook, setup is as follows:
Closed workbook (random filename, random sheet name) has data in single sheet, column A.
Open workbook needs to paste data into existing "data" sheet in the next available column
It seems very simple, but I have been having a hell of a time trying to get it to work, this is the best i can do below, but it returns with an out of range error.
Sub Test
Dim fileName As Variant
Dim tableName, hideRow As String
Dim sheetRange As Range
Dim i As Integer
Dim freecolumn As Integer
Dim newWorkbook As Workbook
Dim currentbook As String
'open dialogue box to get new file to import
fileName = Application.GetOpenFilename
' run update in background
'Application.ScreenUpdating = False
ThisWorkbook.Activate
Sheets("Data").Select
freecolumn = ActiveSheet.UsedRange.Columns.Count + 1
Set newWorkbook = Workbooks.Open(fileName, ReadOnly:=True)
' tried this method, but didnt work
'Workbooks(fileName).Worksheets(1).Range("A:A").Copy _
'Worksheets("Data").Range(freecolumn)
' also tried this
'Workbooks(fileName).Sheets(1).Columns(1).Copy Destination:=Workbooks(currentbook).Sheets("Data").Columns(freecolumn)
'Sheets("Data").Range(freecolumn).Resize(fileName.Rows.Count).Value = fileName.Value
'closedBook.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'closedBook.Close SaveChanges:=False
'Application.ScreenUpdating = True
End Sub
Is this what you are trying? I have commented the code but If you find any bugs or have any questions, feel free to leave a comment below.
CODE
Option Explicit
Sub Sample()
Dim Ret As Variant
Dim wbThis As Workbook, wbThat As Workbook
Dim wsThis As Worksheet, wsThat As Worksheet
Dim LastCol As Long
'~~> Set your current workbook
Set wbThis = ThisWorkbook
'~~> This is the sheet where you want to copy the data to
Set wsThis = wbThis.Sheets("Data")
'~~> Finding last column in data sheet
With wsThis
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastCol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column + 1
Else
LastCol = 1
End If
End With
'~~> Make user choose the file
Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
'~~> If user presses cancel
If Ret = False Then Exit Sub
'~~> Open workbook
Set wbThat = Workbooks.Open(Ret)
'~~> Work with sheet 1
Set wsThat = wbThat.Sheets(1)
'~~> Copy and paste the columns
wsThat.Columns(1).Copy wsThis.Columns(LastCol)
'~~> Close the file without saving
wbThat.Close (False)
End Sub
WORTH A READ
Avoid the use of .Select
Finding last row/column in a worksheet

Copy columns from one workbook to another

I want to fill in the workbook that holds the macro with data from another workbook. The data I need to copy can be on different columns on the source file, depending on the way this source file is generated. So I may run into a problem, because I might get the data I want on a wrong column, or I may even get data I do not want. So I guess it's better to look for the column header (which are always the same string, no matter how the report is generated). I can use the Find method to search for the headers, but how to copy the rows below each header? The range where I want the data pasted are always the same ranges on the paste workbook, and always the first sheet.
Following is my current code:
Sub Import()
' Looks up for the Source Report file and imports its data into wkbk that holds the macro
On Error Resume Next
' Defines Source Report file variable
Dim SourceFile As Variant
' Opens the SourceFile
MsgBox ("Open the SourceFile")
SourceFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
If SourceFile <> False Then
Workbooks.Open Filename:=SourceFile
End If
SourceFileDir = Dir(SourceFile)
' Looks up the last row on SourceFile to copy the entire data later
With Workbooks(SourceFileDir).Worksheets(1)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
' MsgBox ("The last row of data in the Source File is " & LastRow)
' Sets echo off before copying
Application.ScreenUpdating = False
' Copies SourceFile data into paste file, the one that holds the macro
' Serial Number
Workbooks(SourceFileDir).Worksheets(1).Range("E7:E" & LastRow).Copy
ThisWorkbook.Worksheets(1).Range("A38").PasteSpecial xlPasteValues
' Product ID
Workbooks(SourceFileDir).Worksheets(1).Range("A7:A" & LastRow).Copy
ThisWorkbook.Worksheets(1).Range("B38").PasteSpecial xlPasteValues
' Gets out of copy mode
Application.CutCopyMode = False
' Sets echo back on
Application.ScreenUpdating = True
End Sub
The total number of columns I need is 9, the code above just shows two of them, Serial Number and Product ID.
Thanks for your help.
Workbook to Workbook
Adjust the values in the constants section and right below in the Headers array.
Option Explicit
Sub Import()
' Looks up for the Source Report file and imports its data into
' wkbk that holds the macro
Const LastRowColumnS As Long = 1
Const FirstRowS = 7
Const FirstRowP = 38
Dim Headers As Variant
Headers = Array("Serial Number", "Product ID", "ID", _
"Name4", "Name5", "Name6", _
"Name7", "Name8", "Name9")
Dim rng As Range
Dim SourceFile As Variant
Dim wsS As Worksheet
Dim wsP As Worksheet
Dim LastRowS As Long
Dim CurColS As Long
Dim CurColP As Long
Dim NumberOfRows As Long
Dim Count As Long
Dim i As Long
' Opens Source File.
MsgBox ("Open the SourceFile")
SourceFile = Application.GetOpenFilename( _
FileFilter:="Excel Files,*.xl*;*.xm*")
If SourceFile <> False Then
Workbooks.Open Filename:=SourceFile
Else
MsgBox "You selected cancel."
Exit Sub
End If
' Define worksheets.
Set wsS = ActiveWorkbook.Worksheets(1)
Set wsP = ThisWorkbook.Worksheets(1)
' Define last cell with data in Last Row Column of Source Sheet.
Set rng = wsS.Columns(LastRowColumnS).Find( _
What:="*", LookIn:=xlFormulas, SearchDirection:=xlPrevious)
If rng Is Nothing Then
MsgBox "No data in column."
Exit Sub
End If
NumberOfRows = rng.Row - FirstRowS + 1
For i = 0 To UBound(Headers)
' Define column of Current Header in Source Sheet.
Set rng = wsS.Cells.Find(What:=Headers(i), _
After:=wsS.Cells(wsS.Rows.Count, wsS.Columns.Count), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not rng Is Nothing Then
CurColS = rng.Column
' Define column of Current Header in Paste Sheet.
Set rng = wsP.Cells.Find(What:=Headers(i), _
After:=wsP.Cells(wsP.Rows.Count, wsP.Columns.Count), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not rng Is Nothing Then
CurColP = rng.Column
' Write data from Source Sheet to Paste Sheet.
wsP.Cells(FirstRowP, CurColP).Resize(NumberOfRows).Value _
= wsS.Cells(FirstRowS, CurColS).Resize(NumberOfRows).Value
' Count the transfer.
Count = Count + 1
End If
End If
Next i
' Maybe close Source Workbook.
'wsS.Parent.Close False
MsgBox "Transferred data from '" & Count & "' columns."
End Sub
EDIT:
Since some of the headers have different values (names) on each sheet you should use two arrays (one for each sheet) and adjust the values appropriately:
Option Explicit
Sub Import()
' Looks up for the Source Report file and imports its data into
' wkbk that holds the macro
Const LastRowColumnS As Long = 1
Const FirstRowS = 7
Const FirstRowP = 38
Dim HeadSource As Variant
Dim HeadPaste As Variant
HeadSource = Array("Serial Number", "Product ID", "ID", _
"Name4", "Name5", "Name6", _
"Name7", "Name8", "Name9")
HeadPaste = Array("Serial Number", "Product ID", "ID", _
"Name4", "Name5", "Name6", _
"Name7", "Name8", "Name9")
Dim rng As Range
Dim SourceFile As Variant
Dim wsS As Worksheet
Dim wsP As Worksheet
Dim LastRowS As Long
Dim CurColS As Long
Dim CurColP As Long
Dim NumberOfRows As Long
Dim Count As Long
Dim i As Long
' Opens Source File.
MsgBox ("Open the SourceFile")
SourceFile = Application.GetOpenFilename( _
FileFilter:="Excel Files,*.xl*;*.xm*")
If SourceFile <> False Then
Workbooks.Open Filename:=SourceFile
Else
MsgBox "You selected cancel."
Exit Sub
End If
' Define worksheets.
Set wsS = ActiveWorkbook.Worksheets(1)
Set wsP = ThisWorkbook.Worksheets(1)
' Define last cell with data in Last Row Column of Source Sheet.
Set rng = wsS.Columns(LastRowColumnS).Find( _
What:="*", LookIn:=xlFormulas, SearchDirection:=xlPrevious)
If rng Is Nothing Then
MsgBox "No data in column."
Exit Sub
End If
NumberOfRows = rng.Row - FirstRowS + 1
For i = 0 To UBound(HeadSource)
' Define column of Current Header in Source Sheet.
Set rng = wsS.Cells.Find(What:=HeadSource(i), _
After:=wsS.Cells(wsS.Rows.Count, wsS.Columns.Count), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not rng Is Nothing Then
CurColS = rng.Column
' Define column of Current Header in Paste Sheet.
Set rng = wsP.Cells.Find(What:=HeadPaste(i), _
After:=wsP.Cells(wsP.Rows.Count, wsP.Columns.Count), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not rng Is Nothing Then
CurColP = rng.Column
' Write data from Source Sheet to Paste Sheet.
wsP.Cells(FirstRowP, CurColP).Resize(NumberOfRows).Value _
= wsS.Cells(FirstRowS, CurColS).Resize(NumberOfRows).Value
' Count the transfer.
Count = Count + 1
End If
End If
Next i
' Maybe close Source Workbook.
'wsS.Parent.Close False
MsgBox "Transferred data from '" & Count & "' columns."
End Sub

How can I get the specific worksheet in multiple workbook?

For example,
I have 10 classes' exam result.
Each class have their own workbook.
Each workbook have 3 worksheet : English Result, Math Result and Physics Result
How can I get all the Math Result from all the classes and combine it to 1 worksheet?
I tried to write an If-statement to do it but there are some errors.
The code I currently using can only get the result from the workbook that have only 1 worksheet.
Please help me!
Here are the codes I current using:
Sub CombineDataFiles()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
LastDataRow As Long, LastDataCol As Long, _
HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range
'initialize constants
MaxNumberFiles = 2001
HeaderRow = 1 'assume headers are always in row 1
LastOutRow = 1
'prompt user to select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Show
End With
'error trap - don't allow user to pick more than 2000 files
' Can Modify By Changing the 2000
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
MsgBox ("Too many files selected, please pick more than " & MaxNumberFiles & ". Exiting sub...")
Exit Sub
End If
'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)
'loop through all files
For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet
Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
Set DataSheet = DataBook.ActiveSheet
'identify row/column boundaries
LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'if this is the first go-round, include the header
If FileIdx = 1 Then
Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol))
'if this is NOT the first go-round, then skip the header
Else
Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1), DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1), OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
End If
'copy the data to the outbook
DataRng.Copy OutRng
'close the data book without saving
DataBook.Close False
'update the last outbook row
LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' On Error Resume Next
' Range (A1;K100000).Select
' Selection
Next FileIdx
'let the user know we're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")
End Sub
if I understand you right, you want to consolidate lists of data of the same shape (same number and order of columns) from different workbooks. Microsoft has a nice documentary on this:
https://msdn.microsoft.com/en-us/library/cc793964(v=office.12).aspx

VBA to do column consolidation

I am trying to make a consolidated financial statement, which shows all details of subsidiary and consolidated figure in the last column (I plan to use formula for total consolidated figure). I am trying to copy some specific column of worksheet (let's say column C) from selected files (each file has only one sheet with exacltly same layout, structure, and basic data) then paste it into one master sheet (newly added) to show detail of the column C from each file in column B of the master sheet from left to right. Also, I want to show the name of each file in row 1 of the master sheet, but I still can't figure out how to put it in my code.
Here is my code. So far, after I ran it in excel 2010, I found that every column are the same. I don't know what went wrong. I have more than 60 files to do this detailed consolidation. Any help woud be very much appreciated. Thank you.
Sub CombineSheetColumn()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
HeaderRow As Long
Dim DataRng As Range, OutRng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'initialize constants
HeaderRow = 2 'assume headers are always in row 2
LastOutCol = 1
'select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)
'loop through all selected files
For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet
Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
Set DataSheet = DataBook.ActiveSheet
Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 3), DataSheet.Cells(32, 3))
Set OutRng = Range(OutSheet.Cells(HeaderRow + 1, 2), OutSheet.Cells(32, LastOutCol + 1))
'copy the data to the outbook
DataRng.Copy OutRng
'close the data book without saving
DataBook.Close False
'update the last outbook row
LastOutCol = OutSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Next FileIdx
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
to get the filename of the source workbook, you can use:
Cells(32, LastOutCol + 1).value=TargetFiles.SelectedItems(FileIdx).Name
and as for all the data being the same, you could step through and check the columns that are being copied in the source workbook in each iteration of the loop by adding a breakpoint on the line:
DataRng.Copy OutRng

Resources