Non-Contiguous columns in multiple workbooks into New Workbook - Efficiency?

[dimsumpanda]

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! >_<

    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?

[p45cal]

try:

Sub MergeData2()
Dim SummarySheet As Worksheet, FolderPath As String, SelectedFiles(), NRow As Long
Dim FileName As String, NFile As Long, WorkBk As Workbook, SourceRange As Range
Dim DestRange As Range, LastRow As Long

' 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.
  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 & ", $E$1:$F$" & LastRow & ", $L$1:$L$" & LastRow)
  ' Set the destination range to top left cell of destination.
  Set DestRange = SummarySheet.Range("A" & NRow)
  
  
  ' Copy over from the source to the destination.
  'Use:
  SourceRange.Copy DestRange ' can use this line instead of the 3 below - it copies everything, formats and all.
  'or these next 3 which copy over only the values (dates look ugly):
'  SourceRange.Copy
'  DestRange.PasteSpecial xlPasteValues
'  Application.CutCopyMode = False
  
  
  ' Increase NRow so that we know where to copy data next.
  NRow = NRow + SourceRange.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
'Application.Goto SummarySheet.Cells(1, 1) 'this line only needed to select A1 if xlPasteValues is used above.
End Sub

Comments in code re variations.

Can also try:

Sub MergeData3()
Dim SummarySheet As Worksheet, FolderPath As String, SelectedFiles(), NRow As Long, FileName

Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
FolderPath = "C:\Users\Documents\ExcelVBApractice\"
ChDrive FolderPath
ChDir FolderPath
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
NRow = 1
' Loop through the list of returned file names
For Each FileName In SelectedFiles
  With Workbooks.Open(FileName).Worksheets(1)

      'Copy over from the source to the destination.
      'Use:
      Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy SummarySheet.Cells(NRow, 1)  ' can use this line instead of the 3 below - it copies everything, formats and all.
      'or these next 3 which copy over only the values (dates look ugly):

      'Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy
      'SummarySheet.Cells(NRow, 1).PasteSpecial xlPasteValues
      'Application.CutCopyMode = False

    .Parent.Close savechanges:=False
  End With  'Workbooks.Open(FileName).Worksheets(1)
  'Update NRow:
  NRow = SummarySheet.UsedRange.Rows(SummarySheet.UsedRange.Rows.Count).Row + 1
Next FileName
SummarySheet.Columns.AutoFit
'Application.Goto SummarySheet.Cells(1, 1) 'this line only needed to select A1 if xlPasteValues is used above.
End Sub

Again see comments in code.

[dimsumpanda]

Oh wow!! Thank you so much; both macros work wonderfully and the code look much nicer than before! If you don't mind, I do have a few questions and comments as I was trying to learn from the code you posted.

Range("$A$1:$C$" & LastRow & ", $E$1:$F$" & LastRow & ", $L$1:$L$" & LastRow).

Ah, so that's how I can combine several columns into a range! I was looking all over trying to figure out how to do it.
How come the commas go inside the quotation marks? I tried to move them and I got an error. Is it because the '& 'connects the two strings together? (I'm still very new to the VBA syntax)

The copy and paste method is also really nice. Thank you for adding the comments. I came across the three lines of code that can help copy and paste ranges before, but I didn't know there was a short-hand for it.

Hmmm... I looked up intersect and UsedRange. I understand intersect now, but what does UsedRange do here?:

Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy SummarySheet.Cells(NRow, 1)

[p45cal]

How come the commas go inside the quotation marks? I tried to move them and I got an error. Is it because the '& 'connects the two strings together? (I'm still very new to the VBA syntax)

If you record a macro of you selecting those columns you get:
Range("A:C,E:F,L:L").Select
from which you can see where the commas go. Duplicate that.

Hmmm... I looked up intersect and UsedRange. I understand intersect now, but what does UsedRange do here?:

Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy SummarySheet.Cells(NRow, 1)

Add a new sheet, put something in C10 and something in F3, then in the Immediate pane (Ctrl+G if you can't see it in the VBE) type:
Activesheet.usedrange.select
then look at the sheet. This should give you a good idea of what it is.
Excel's own help says: "Returns a Range object that represents the used range on the specified worksheet."

[dimsumpanda]

Now I get it, thank you.

[Opeyrasse]

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

[p45cal]

Untested, just changing the for..next loop:

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.

[Opeyrasse]

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

Untested, just changing the for..next loop:

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.

[snb]

For Each FileName In SelectedFiles 
  With getobject(FileName) 
    sn= .sheets(1).usedrange
    .close 0
  end with

  sp=application.index(sn,evaluate("row(1:"&ubound(sn)&")"),array(3,4,5,9,2,10,8)
  summarysheet.cells(rows.count,1).end(xlup).offset(2).resize(ubound(sp),ubound(sp,2))=sp
next

[p45cal]

How are you going to go about selecting files? Only 2 at a time?