Copy Columns from multiple workbooks to one workbook

[nwixx]

Hello! I am very new to VBA, and my stumbling block is this. I have three workbooks. Although they have other columns, the columns they have in common are apples, oranges, and grapes, and they are not in the same order in each of the workbooks. Is it possible to copy the information in apples, oranges, and grapes from each of these workbooks to a new workbook of just these columns?

Any help is much appreciated!

 

[My Aswer Is This]

Are we to assume the values:
apples, oranges, and grapes

Are in row one of sheet1 of these three Workbooks?
If not how do we know what column is apples, oranges, and grapes

And where in Workbook4 will these columns be paste to.

Has Workbook4 already been created?

And you should know all Workbooks will need to be open.

What are the names of all these workbooks.

See we need details like this.

 

[nwixx]

Wow, thanks for the quick reply! & sorry that I didn't include all the the necessary information.

apples, oranges, grapes are in row one of sheet1 of each workbook, and I would like them in row one of sheet one (starting at "A1") of workbook 4.

Workbook 4 has not been created yet, but I can create it if its easier that way.

For now the names of the workbooks are : testbk1, testbk2, testbk3.

 

[My Aswer Is This]

I do not understand this comment:
Your quote:

I would like them in row one of sheet one (starting at "A1") of workbook 4.

So you have 3 columns of data on three different workbooks and you want all this data copied into Workbook 4 sheet1

Your quote:

in row one of sheet one (starting at "A1") of workbook 4.

In row one????

So the first value goes in A1 second value in "B1" third value in "C1" etc. etc.
This is what you want??

You said "row one" not "column one"


So all the data will be pasted into just one row on sheet1 of Workbook4

 

[nwixx]

I guess I'm not explaining this well. let's say we want to compile all of the information under apples, oranges and grapes from each of the other workbooks into the correct columns in workbook 4. Maybe you can see what I'm trying to convey below.

Workbook 1:
Apples Bananas Oranges Plums Grapes
(data) (data) (data) (data) (data)
(data) (data) (data) (data) (data)
(data) (data) (data) (data) (data)

Workbook 2:

Oranges Apples Bananas Grapes Plums
(data) (data) (data) (data) (data)
(data) (data) (data) (data) (data)
(data) (data) (data) (data) (data)

Workbook 3:
Apples Plums Oranges Plums Bananas
(data) (data) (data) (data) (data)
(data) (data) (data) (data) (data)
(data) (data) (data) (data) (data)

Workbook 4:
Apples Oranges Grapes
(data) (data) (data)
(data) (data) (data)
(data) (data) (data)
(data) (data) (data)
(data) (data) (data)
(data) (data) (data)
(data) (data) (data)
(data) (data) (data)
(data) (data) (data)


Thank you for trying to help me sort this out!

 

[My Aswer Is This]

This may be more complicated then I'm able to accomplish. There are lots of other people here at Mr. Excel who I'm sure can help you. At least now we have a lot more details.

 

[nwixx]

I really appreciate all of the questions to get a better understanding and make things more clear

 

[My Aswer Is This]

I will try later to see if I can get a good answer if no one else comes up with a answer.

I really appreciate all of the questions to get a better understanding and make things more clear

 

[Fluff]

Hia
try this

Sub CopyColsFrom3Wbk()
' nwixx

    Dim FNames As Variant
    Dim NewSht As Worksheet
    Dim Cnt As Long
    Dim Valu As Variant
    Dim OldCol As Long
    Dim NewCol As Long
    Dim Arr() As Variant
    
Application.ScreenUpdating = False

    ChDrive "[COLOR=#ff0000]C:[/COLOR]"
    ChDir "[COLOR=#ff0000]C:\Users\Fluff\Desktop\test\[/COLOR]"
    
    Arr = Array("[COLOR=#0000ff]Dlow[/COLOR]", "[COLOR=#0000ff]Volume[/COLOR]", "[COLOR=#0000ff]SMA20[/COLOR]")
    
    Do
        FNames = Application.GetOpenFilename(FileFilter:="Excel workbooks (*.xls*),*.xls*", Title:="Select 3 files to import", MultiSelect:=True)
        If Not IsArray(FNames) Then
            MsgBox "You pressed Cancel, Macro will quit"
            Exit Sub
        ElseIf UBound(FNames) <> 3 Then
            MsgBox "You have not selected 3 files." & vbLf & "Use ""Ctrl+left click"" to select 3 files."
        End If
    Loop Until UBound(FNames) = 3

    Workbooks.Add (1)
    Set NewSht = ActiveSheet
    With NewSht
        .Range("A1") = Arr(0)
        .Range("B1") = Arr(1)
        .Range("C1") = Arr(2)
    End With
    
    NewCol = 1
    
    For Cnt = 1 To UBound(FNames)
        Workbooks.Open FNames(Cnt)
        For Each Valu In Arr
            OldCol = Rows(1).Find(Valu).Column
            Range(Cells(2, OldCol), Cells(Rows.Count, OldCol).End(xlUp)).Copy _
                NewSht.Cells(Rows.Count, NewCol).End(xlUp).Offset(1)
            NewCol = NewCol + 1
        Next Valu
        NewCol = 1
        ActiveWorkbook.Close False
    Next Cnt

End Sub

Change the parts in red to match your drive & path names.
& change the parts in blue to match your header values

 

[nwixx]

Wow, that is excellent...I ran the code and it works!! Now I have to study the mechanics of it so maybe I can understand what you just did!

Thanks for helping me out...I've got a long way to go