3 Attachment(s)
Non-Contiguous columns in multiple workbooks into New Workbook - Efficiency?
Hello, I would like to combine data from non-contiguous columns from multiple workbooks and paste the data together into a summary workbook. I want to combine columns A:C and column E:F, and column L from multiple workbooks (these are arbitrary columns that I picked to work with).
Looking online, I found a really helpful tutorial on how to merge data from multiple workbooks into a Summary Workbook:
https://msdn.microsoft.com/en-us/library/office/gg549168%28v=office.14%29.aspx
However, I can only seem to merge data from one range of columns at a time. I tried to use Union(DestRange, DestRange2), but DestRange2 (the second range) doesn't appear in the new workbook.
Instead, I separated the column ranges and repeated the copy and paste methods 3 times with each different range. This works, but I feel like there should be a much more efficient way of doing this. I am very new to VBA, so any help would be extremely appreciated! >_<
Code:
Sub MergeData() Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim SelectedFiles() As Variant
Dim NRow As Long
Dim FileName As String
Dim NFile As Long
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim DestRange2 As Range
Dim DestRange3 As Range
Dim SourceRange2 As Range
Dim SourceRange3 As Range
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Documents\ExcelVBApractice\"
' Set the current directory to the the folder path.
ChDrive FolderPath
ChDir FolderPath
' Open the file dialog box and filter on Excel files, allowing multiple files
' to be selected.
SelectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Loop through the list of returned file names
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
' Set FileName to be the current workbook file name to open.
FileName = SelectedFiles(NFile)
' Open the current workbook.
Set WorkBk = Workbooks.Open(FileName)
' Create the variable for the last row.
Dim LastRow As Long
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
' Set the source range, i.e. the columns to copy.
Set SourceRange = WorkBk.Worksheets(1).Range("$A$1:$C$" & LastRow)
Set SourceRange2 = WorkBk.Worksheets(1).Range("$E$1:$F$" & LastRow)
Set SourceRange3 = WorkBk.Worksheets(1).Range("$L$1:$L$" & LastRow)
' Set the destination range to start at column A and be the same size as the source range.
Set DestRange = SummarySheet.Range("A" & NRow)
Set DestRange2 = SummarySheet.Range("D" & NRow)
Set DestRange3 = SummarySheet.Range("F" & NRow)
' Modify this range for your workbooks. It can span multiple rows.
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
Set DestRange2 = DestRange2.Resize(SourceRange2.Rows.Count, SourceRange2.Columns.Count)
Set DestRange3 = DestRange3.Resize(SourceRange3.Rows.Count, SourceRange3.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
DestRange2.Value = SourceRange2.Value
DestRange3.Value = SourceRange3.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
Next NFile
' Call AutoFit on the destination sheet so that all data is readable.
SummarySheet.Columns.AutoFit
End Sub
- If I am working with a lot of non-contiguous columns that appear in multiple workbooks, how can I combine them into one workbook efficiently?
- If I want to select columns singularly (instead of E:F, just column E), would I still use the Range method or the Column method?
- I attached the world fertility rate dataset that I pulled from the worldbank. I separated the information into 2 different workbooks and deleted several columns and worksheets to make the file smaller. If you run the code and select both worksheets, it should look like the whatItShouldLookLike.xlsx file.
- If I only want columns A:C, E:F (2005-2006), and column L (2012) from the two workbooks, how can I use VBA to without repeating the methods manually?
Selecting different columns from each sourcesheet
Hi, I am using the same code and have found it really useful reading through this so thanks. In my case however I am trying to select different columns for each of the 2 source files and can't for the life of me how to go about it as the looping function obviously uses the same column mapping.
I'm trying map the following sourcesheet columns TO output worksheet columns:
Sheet 1:
C TO A
D TO B
E TO C
I TO D
Sheet 2:
B TO F
J TO G
H TO H
C TO I
How can I adapt this code to allow for this? Any help is massively appreciated... I feel I am going around in circles at the moment :-(
Thanks,
Olivier
Sourcesheets are in different workbooks
Hi p45cal,
Thanks so much for helping out with this, and so quickly! I think I didn't explain very well however... the two sourcesheets are in different workbooks. I.e. each is a different file, and each is in sheet 1 of their respective workbooks.
I think with your previous comment, it will work with different sheets but not different workbooks.
Thanks again,
Olivier
Quote:
Originally Posted by
p45cal
Untested, just changing the for..next loop:
Code:
For Each FileName In SelectedFiles
With Workbooks.Open(FileName)
With .Worksheets(1)
Intersect(.UsedRange, .Range("C:E,I:I")).Copy SummarySheet.Cells(NRow, 1) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("C:E,I:I")).Copy
'SummarySheet.Cells(NRow, 1).PasteSpecial xlPasteValues
End With '.Worksheets(1)
With .Worksheets(2)
Intersect(.UsedRange, .Range("B:B")).Copy SummarySheet.Cells(NRow, 6) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("B:B")).Copy
'SummarySheet.Cells(NRow, 6).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("J:J")).Copy SummarySheet.Cells(NRow, 7) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("J:J")).Copy
'SummarySheet.Cells(NRow, 7).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("H:H")).Copy SummarySheet.Cells(NRow, 8) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("H:H")).Copy
'SummarySheet.Cells(NRow, 8).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("C:C")).Copy SummarySheet.Cells(NRow, 9) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("C:C")).Copy
'SummarySheet.Cells(NRow, 9).PasteSpecial xlPasteValues
'Application.CutCopyMode = False 'this line only needed when using the xlPasteValues lines above.
End With '.Worksheets(2)
.Parent.Close savechanges:=False
End With 'Workbooks.Open(FileName)
.Worksheets(1) and
.Worksheets(2) in the code above refer to the worksheets in the order they appear in in the workbook you're copying from. If they have consistent names then you can substitute
.Worksheets("TheFirstSheet") and
.Worksheets("SomeOtherSheet") obviously using the names of your actual worksheets instead.
