Copying Multiple workbooks columns into another workbook.

[Motestfilter]

Hi,

Good morning. I am very new to this. I am currently trying to create my first macro with the function of copying specific columns from different workbooks (4 workbooks) to a "master" workbook. The copied column should proceed to the last row on the master file. My code is painful to look at but it kind of works when I was just trying to copy from a single workbook but all hell broke loose when I tried to add another workbook to be copied from.

Sub Button1_Click()Dim a As Worksheet, y As Worksheet, LastRow&, b As Worksheet, c As Worksheet, d As Worksheet


Workbooks.Open ("C:\Users\Totoro\Desktop\Test\Test1.xlsx")
Workbooks.Open ("C:\Users\Totoro\Desktop\Test\Test2.xlsx")
Workbooks.Open ("C:\Users\Totoro\Desktop\Test\Test3.xlsx")
Workbooks.Open ("C:\Users\Totoro\Desktop\Test\Test4.xlsx")




Set a = Workbooks("Test1.xlsx").Worksheets("Sheet")
Set b = Workbooks("Test2.xlsx").Worksheets("Sheet")
Set c = Workbooks("Test3.xlsx").Worksheets("Sheet")
Set d = Workbooks("Test4.xlsx").Worksheets("Sheet")


Set x = ThisWorkbook.Worksheets("Sheet1")


    LastRow = a.Cells.SpecialCells(xlCellTypeLastCell).Row
    a.Range("A1:A" & LastRow).Copy x.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)


    LastRow = b.Cells.SpecialCells(xlCellTypeLastCell).Row
     b.Range("A1:A" & LastRow).Copy x.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)


    LastRow = c.Cells.SpecialCells(xlCellTypeLastCell).Row
     c.Range("A1:A" & LastRow).Copy x.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)


    LastRow = d.Cells.SpecialCells(xlCellTypeLastCell).Row
     d.Range("A1:A" & LastRow).Copy x.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)




Application.CutCopyMode = False


End Sub

On this code I am just trying to copy from a single column but I would later on add other columns when I figure out what am I doing.

1. Is it possible to do it without opening the source workbook?

 

[Motestfilter]

Forgot to add that the column positions differ between workbooks and workbooks have differing number of columns. So basically, the logic would be searching for the columns I need, and then copy those columns of data from the workbooks and combine them into one master file.

 

[Motestfilter]

I've tried using this code:

Sub Merges()

    Dim strFileName As String
    Dim strFilesLike As String
    Dim strPathName As String
    Dim strCurrentFile As String
 pth = "C:\Users\totoro\Desktop\CSAT\"
Set tgt = Workbooks.Open(pth & "master.xlsm")
    strPathName = "C:\Users\totoro\Desktop\CSAT\"
    strFilesLike = "*.xlsx*"
    strFileName = strPathName & strFilesLike


    strCurrentFile = Dir(strFileName)
    Do While strCurrentFile <> ""
    
        ' Combine file data code goes here
 Set src = Workbooks.Open(strFileName)
      Set dest = tgt.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Set src = ActiveWorkbook
    With src.Sheets("Sheet1")
        Set colh = .Range("1:1").Find("Respondent ID")
        cnt = Cells(Rows.Count, colh.Column).End(xlUp).Row - 1
        dest.Resize(cnt).Value = colh.Offset(1).Resize(cnt).Value
        Set colh = .Range("1:1").Find("Start Date")
        dest.Offset(, 1).Resize(cnt).Value = colh.Offset(1).Resize(cnt).Value
    End With
    src.Close False
        ' Get next file to Import
        strCurrentFile = Dir
    Loop
  


End Sub

but I am getting a "method of open workbooks failed" error and it highlights " Set src = Workbooks.Open(strFileName)"

 

[mohadin]

Hi
try to change to

 Set src = Workbooks.Open(strCurrentFile)

 

[Motestfilter]

Hi
try to change to

 Set src = Workbooks.Open(strCurrentFile)

Hi. Thanks for the reply. Tried that and got this error:

"Sorry we couldn't find. Is it possible it was moved, renamed or deleted?" with this highlighted - Set src = Workbooks.Open(strCurrentFile)

 

[mohadin]

So you have to check the file extension xlsx?

 

[Motestfilter]

So you have to check the file extension xlsx?

yep they all are except for the master file

 

[mohadin]

 Set src = Workbooks.Open(strPathName & strCurrentFile)

 

[Motestfilter]

 Set src = Workbooks.Open(strPathName & strCurrentFile)

Thanks a lot. it worked! Do you know which part should I change so it would start pasting on the second columns rather than the first one and also to paste it on the 10th row instead of the third? thanks

 

[mohadin]

Well try to play with .offset