Help copying colums from multiple spreadsheets

[mwlemaster]

I'm just a user of Excel and I just need a simple add in to select rows or columns from multiple spreadsheets and insert them into a new spreasheet. I found one called RDBMerge that almost does it, but gives me errors when I try to copy more than one column at a time. I can't seem to find anything that can do this simple task...Any help would be appreciated

[HansV]

Welcome to Eileen's Lounge!

If you could describe in more detail what you want to do, we'll be better able to help you. Thanks in advance.

[mwlemaster]

I have 7 seperate spreadsheets that are numbered 1 through 7. I am trying to pull colums c, e & w from each of them and place them into one single spreadsheet beginning with the data from spreadsheet 1, then appending spreadsheet 2, then 3, etc.... in a nutshell. Thanks for your help.

[HansV]

OK, thanks. By "spreadsheets", do you mean worksheets within the same workbook, or separate workbooks (Excel files)?

[mwlemaster]

Seperate workbooks

[HansV]

Here is a macro you could use. When you run it, you'll be prompted to select the source workbooks - you can select multiple files.
The results will be pasted into a new workbook.
I have assumed that the data are in the first sheet in each workbook.

Code: Select all

Sub MergeFiles()
  Dim wbkSrc As Workbook
  Dim wbkTrg As Workbook
  Dim wshSrc As Worksheet
  Dim wshTrg As Worksheet
  Dim i As Integer
  Dim c As Variant
  Dim s As Long
  Dim t As Long
  With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel workbooks", "*.xls*"
    .AllowMultiSelect = True
    If .Show = True Then
      Application.ScreenUpdating = False
      Set wbkTrg = Workbooks.Add(xlWBATWorksheet)
      Set wshTrg = wbkTrg.Worksheets(1)
      For i = 1 To .SelectedItems.Count
        Set wbkSrc = Workbooks.Open(.SelectedItems(i))
        Set wshSrc = wbkSrc.Worksheets(1)
        For Each c In Array(3, 5, 23)
          s = wshSrc.Cells(wshSrc.Rows.Count, c).End(xlUp).Row
          t = wshTrg.Cells(wshTrg.Rows.Count, c).End(xlUp).Row + 1
          wshSrc.Range(wshSrc.Cells(1, c), wshSrc.Cells(s, c)).Copy _
            Destination:=wshTrg.Cells(t, c)
        Next c
        wbkSrc.Close SaveChanges:=False
      Next i
      Application.ScreenUpdating = False
    End If
  End With
End Sub

[mwlemaster]

This is EXCELLENT....But can I ask one more favor??? Could I get it to put the data into columns A B & C...Otherwise, absolutely perfect. Thanks so much!

[HansV]

This slight modification will place the data in columns A:C.

Code: Select all

Sub MergeFiles()
  Dim wbkSrc As Workbook
  Dim wbkTrg As Workbook
  Dim wshSrc As Worksheet
  Dim wshTrg As Worksheet
  Dim i As Integer
  Dim c As Variant
  Dim d As Long
  Dim s As Long
  Dim t As Long
  With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel workbooks", "*.xls*"
    .AllowMultiSelect = True
    If .Show = True Then
      Application.ScreenUpdating = False
      Set wbkTrg = Workbooks.Add(xlWBATWorksheet)
      Set wshTrg = wbkTrg.Worksheets(1)
      For i = 1 To .SelectedItems.Count
        Set wbkSrc = Workbooks.Open(.SelectedItems(i))
        Set wshSrc = wbkSrc.Worksheets(1)
        d = 1
        For Each c In Array(3, 5, 23)
          s = wshSrc.Cells(wshSrc.Rows.Count, c).End(xlUp).Row
          t = wshTrg.Cells(wshTrg.Rows.Count, d).End(xlUp).Row + 1
          wshSrc.Range(wshSrc.Cells(1, c), wshSrc.Cells(s, c)).Copy _
            Destination:=wshTrg.Cells(t, d)
          d = d + 1
        Next c
        wbkSrc.Close SaveChanges:=False
      Next i
      Application.ScreenUpdating = False
    End If
  End With
End Sub

[mwlemaster]

Perfect!...Thanks so much. I've been trying to figure something out for a week now and coouldn't. This will save me a lot of time. Thanks again.

[HansV]

You're welcome! Feel free to post more questions if you have them...