Pulling data from 3 workbooks into 1 workbook

mlarson · Sep 8, 2011

Hello everybody, I am trying to figure out the proper macro that will automatically (say at 5am each morning) pull data from 3 closed workbooks (named BOOK1, BOOK2, and BOOK3) and place it into a separate workbook named BOOK4 (preferably closed, but that’s not necessary). I would also like the macro to automatically handle alerts by choosing update/yes/ok (examples: EnableEvents=true, PrivacyWarning=true, Update=true). I am using Excel 2010 and Windows 7. I’m hoping this is enough info to create the macro but let me know if there is additional info that is needed. Thank you in advance for your help!

My workbooks are much larger, but for simplicity’s sake below is a sample of the information I want to pull from the notebook (and sheet within that notebook) and place it in BOOK4:

BOOK1(Sheet1, Column A) – I want to move this info into BOOK4(Sheet1, Column A)
135
145
150
276
AXE
BRE

BOOK2(Sheet3, Column C) – I want to move this info into BOOK4(Sheet1, Column B)
476
495
455
504
LST
RZY

BOOK3(Sheet1, Column B) – I want to move this info into BOOK4(Sheet1, Column C)
128
441
325
635
FAU
GPT

Z0Mb!MaN · Sep 8, 2011

Sub ThreeToOne()
'
' ThreeToOne /// copy three columns into new sheet
' recorded by: Z0Mb!M@N

Sheets.Add
Sheets(1).Select
Sheets(1).Name = "backup"

Sheets("Sheet1").Select
Columns("A:A").Select
Selection.Copy
Sheets("backup").Select
Columns("A:A").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("backup").Select
Columns("B:B").Select
ActiveSheet.Paste
Sheets("Sheet3").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("backup").Select
Columns("C:C").Select
ActiveSheet.Paste
End Sub

brettdj · Sep 8, 2011

I've written a vbscript solution below. You can use a vbs with Windows scheduler to run each morning, see http://www.iopus.com/guides/winscheduler.htm

I have used a array to hold your book information, there are four elements to each array record
Book Name, Sheet Index, Column to Copy From, Column to Copy to

Pls change your directory to suit

This code copies accross the whole column, if you want to append data it will need to be modified

hth

Dave

Code:

    Dim objExcel
    Dim WB1
    Dim WB2
    Dim strPath
    Dim ArrWB(4, 4)
    ' Book Name, Sheet Position, Column to Copy From, COlumn to Copy to
    ArrWB(1, 1) = "Book4"
    ArrWB(2, 1) = "Book1"
    ArrWB(2, 2) = 1
    ArrWB(2, 3) = 1
    ArrWB(2, 4) = 1
    ArrWB(3, 1) = "Book2"
    ArrWB(3, 2) = 3
    ArrWB(3, 3) = 3
    ArrWB(3, 4) = 2
    ArrWB(4, 1) = "Book3"
    ArrWB(4, 2) = 1
    ArrWB(4, 3) = 2
    ArrWB(4, 4) = 3
    strPath = "C:\temp"
    Set objExcel = CreateObject("excel.application")
    With objExcel
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    Set WB1 = objExcel.Workbooks.Open(strPath & "\" & ArrWB(1, 1))
    For lngbook = 2 To UBound(ArrWB, 1) - 1
        Set WB2 = objExcel.Workbooks.Open(strPath & "\" & ArrWB(lngbook, 1))
        WB2.Sheets(ArrWB(lngbook, 2)).Columns(ArrWB(lngbook, 3)).Copy WB1.Sheets(1).Columns(ArrWB(lngbook, 4))
        WB2.Close False
    Next
    WB1.Save
    WB1.Close
      With objExcel
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    objExcel.Quit
    Set objExcel = Nothing

mlarson · Sep 9, 2011

Since my workbooks are named BOOK1, BOOK2, BOOK3, and BOOK4, do I need to add those names into the code? I changed the directory to "C:\Users\Mark\Desktop"

Here's where I'm at right now...

Code:

Sub ThreeToOne()

Dim objExcel
    Dim WB1
    Dim WB2
    Dim strPath
    Dim ArrWB(4, 4)

' Book Name, Sheet Position, Column to Copy From, COlumn to Copy to
    ArrWB(1, 1) = "Book4"
    ArrWB(2, 1) = "Book1"
    ArrWB(2, 2) = 1
    ArrWB(2, 3) = 1
    ArrWB(2, 4) = 1

    ArrWB(3, 1) = "Book2"
    ArrWB(3, 2) = 3
    ArrWB(3, 3) = 3
    ArrWB(3, 4) = 2
    ArrWB(4, 1) = "Book3"
    ArrWB(4, 2) = 1
    ArrWB(4, 3) = 2
    ArrWB(4, 4) = 3
    strPath = "C:\Users\Mark\Desktop"

    Set objExcel = CreateObject("excel.application")
    With objExcel
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    Set WB1 = objExcel.Workbooks.Open(strPath & "\" & ArrWB(1, 1))

    For lngbook = 2 To UBound(ArrWB, 1) - 1
        Set WB2 = objExcel.Workbooks.Open(strPath & "\" & ArrWB(lngbook, 1))
        WB2.Sheets(ArrWB(lngbook, 2)).Columns(ArrWB(lngbook, 3)).Copy WB1.Sheets(1).Columns(ArrWB(lngbook, 4))

        WB2.Close False
    Next
    WB1.Save
    WB1.Close
      With objExcel
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    objExcel.Quit
    Set objExcel = Nothing

End Sub

mlarson · Sep 9, 2011

Since my workbooks are named BOOK1, BOOK2, BOOK3, and BOOK4 (with BOOK4 being where I want all the information to be compiled), do I need to add those names into the code? I changed the directory to "C:\Users\Mark\Desktop"

Here's where I'm at right now...

Code:

Sub ThreeToOne()

Dim objExcel
    Dim WB1
    Dim WB2
    Dim strPath
    Dim ArrWB(4, 4)

' Book Name, Sheet Position, Column to Copy From, COlumn to Copy to
    ArrWB(1, 1) = "Book4"
    ArrWB(2, 1) = "Book1"
    ArrWB(2, 2) = 1
    ArrWB(2, 3) = 1
    ArrWB(2, 4) = 1

    ArrWB(3, 1) = "Book2"
    ArrWB(3, 2) = 3
    ArrWB(3, 3) = 3
    ArrWB(3, 4) = 2
    ArrWB(4, 1) = "Book3"
    ArrWB(4, 2) = 1
    ArrWB(4, 3) = 2
    ArrWB(4, 4) = 3
    strPath = "C:\Users\Mark\Desktop"

    Set objExcel = CreateObject("excel.application")
    With objExcel
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    Set WB1 = objExcel.Workbooks.Open(strPath & "\" & ArrWB(1, 1))

    For lngbook = 2 To UBound(ArrWB, 1) - 1
        Set WB2 = objExcel.Workbooks.Open(strPath & "\" & ArrWB(lngbook, 1))
        WB2.Sheets(ArrWB(lngbook, 2)).Columns(ArrWB(lngbook, 3)).Copy WB1.Sheets(1).Columns(ArrWB(lngbook, 4))

        WB2.Close False
    Next
    WB1.Save
    WB1.Close
      With objExcel
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    objExcel.Quit
    Set objExcel = Nothing

End Sub

brettdj · Sep 12, 2011

Thats right

Did this work for you?

Regards

Dave

mlarson · Sep 12, 2011

Dave, it didn't seem to work. Anything in the code that you think I am missing?

brettdj · Sep 19, 2011

Hi,

What happened when you tried this, did you get an error, did Book4 get partially updated etc?

Cheers

Dave

mlarson · Sep 20, 2011

Dave, I think I figured it out. Thanks for your help on this!

brettdj · Sep 21, 2011

No probs, thx for the feedback

Pulling data from 3 workbooks into 1 workbook

mlarson

Well-known Member

Excel Facts

Z0Mb!MaN

New Member

brettdj

Active Member

mlarson

Well-known Member

mlarson

Well-known Member

brettdj

Active Member

mlarson

Well-known Member

brettdj

Active Member

mlarson

Well-known Member

brettdj

Active Member

Similar threads

Forum statistics

Share this page

Pulling data from 3 workbooks into 1 workbook

Well-known Member

Excel Facts

New Member

Active Member

Well-known Member

Well-known Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock