EXPORT SPECIFIC COLUMNS on current workbook TO ANOTHER WORKBOOK AND DIFFERENT COLUMNS

Trying to find some code but not coming up with what I need:

Excel 2010
2 excel files  

Data is defined as "Used Range"


What I need: To export columns B and E and F and  T to another workbook.

Columns Mapped by   B = C           E  =  G              F = R         T = U

EXPORT data FROM CURRENT WORKBOOK   to a Another workbook in a static location:  C:\Program Files\Data\Exported_Data.xlsx

Thanks
fordraiders
LVL 3
FordraidersAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ejgil HedegaardCommented:
Try this code

Option Explicit
Dim wb As Workbook, rwMax As Long, ws As Worksheet

Sub ExportData()
    Set ws = ActiveSheet
    rwMax = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
    Set wb = Workbooks.Open(Filename:="C:\Program Files\Data\Exported_Data.xlsx")
    CopyData "B", "C"
    CopyData "E", "G"
    CopyData "F", "R"
    CopyData "T", "U"
    wb.Close SaveChanges:=True
End Sub

Sub CopyData(colFrom As String, colTo As String)
    ThisWorkbook.Activate
    ws.Range(colFrom & "1:" & colFrom & rwMax).Copy
    wb.Activate
    Range(colTo & 1).Select
    ActiveSheet.Paste
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Or another way.....

Sub CopyDataToAnotherWorkbook()
Dim Swb As Workbook, Dwb As Workbook
Dim Sws As Worksheet, Dws As Worksheet
Dim fPath As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

fPath = "C:\Program Files\Data\Exported_Data.xlsx"           'Full Path of the the Destination workbook

Set Swb = ThisWorkbook                              'Source Workbook with the Code
Set Sws = Swb.Sheets("Sheet1")                   'Source Sheet
On Error Resume Next
Workbooks.Open fPath
If Err = 0 Then
    Set Dwb = ActiveWorkbook                        'Destination Workbook
    Set Dws = Dwb.Sheets("Sheet1")                'Destination Sheet
    
    Sws.Range("B1", Sws.Range("B" & Rows.Count).End(3)).Copy Dws.Range("C1")
    Sws.Range("E1", Sws.Range("E" & Rows.Count).End(3)).Copy Dws.Range("G1")
    Sws.Range("F1", Sws.Range("F" & Rows.Count).End(3)).Copy Dws.Range("R1")
    Sws.Range("T1", Sws.Range("T" & Rows.Count).End(3)).Copy Dws.Range("U1")
    Application.CutCopyMode = 0
    Dwb.Close True
Else
    MsgBox "Unable to open the file. Please check to see if the file exists.", vbExclamation, "File Not Found!"
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done.", vbInformation
End Sub

Open in new window

FordraidersAuthor Commented:
sktneer, Yours works ok if all columns have data in them.
If any column does not contain any data...its grabbing the column header and bringing it over for some reason..

Thanks
fordraiders
CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

FordraidersAuthor Commented:
ejgil,
get an automation error on line:

 ws.Range(colFrom & "1:" & colFrom & rwMax).Copy
FordraidersAuthor Commented:
ejgil, sorry...
debugging on wrong line ?
still checking
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
In that case you may try something like this.....
Sub CopyDataToAnotherWorkbook()
Dim Swb As Workbook, Dwb As Workbook
Dim Sws As Worksheet, Dws As Worksheet
Dim fPath As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

fPath = "C:\Program Files\Data\Exported_Data.xlsx"           'Full Path of the the Destination workbook

Set Swb = ThisWorkbook                              'Source Workbook with the Code
Set Sws = Swb.Sheets("Sheet1")                   'Source Sheet
On Error Resume Next
Workbooks.Open fPath
If Err = 0 Then
    Set Dwb = ActiveWorkbook                        'Destination Workbook
    Set Dws = Dwb.Sheets("Sheet1")                'Destination Sheet
    If WorksheetFunction.CountA(Sws.Range("B:B")) > 1 Then
        Sws.Range("B2", Sws.Range("B" & Rows.Count).End(3)).Copy Dws.Range("C2")
    End If
    If WorksheetFunction.CountA(Sws.Range("E:E")) > 1 Then
        Sws.Range("E2", Sws.Range("E" & Rows.Count).End(3)).Copy Dws.Range("G2")
    End If
    If WorksheetFunction.CountA(Sws.Range("F:F")) > 1 Then
        Sws.Range("F2", Sws.Range("F" & Rows.Count).End(3)).Copy Dws.Range("R2")
    End If
    If WorksheetFunction.CountA(Sws.Range("T:T")) > 1 Then
        Sws.Range("T2", Sws.Range("T" & Rows.Count).End(3)).Copy Dws.Range("U2")
    End If
    Application.CutCopyMode = 0
    Dwb.Close True
Else
    MsgBox "Unable to open the file. Please check to see if the file exists.", vbExclamation, "File Not Found!"
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done.", vbInformation
End Sub

Open in new window


The above code will copy the data if the target columns have data other than column headers and paste it to the destination columns without column headers on row2.

Notice B2 and C2 in the following line of code i.e. code copies the data row2 downwards and paste it on row2 of target column C in the destination worksheet.
Sws.Range("B2", Sws.Range("B" & Rows.Count).End(3)).Copy Dws.Range("C2")

Open in new window


If you want to copy the data including the target headers and paste it on the destination worksheet with target columns headers, change the above line of code with this one...
Sws.Range("B1", Sws.Range("B" & Rows.Count).End(3)).Copy Dws.Range("C1")

Open in new window


Hope this helps.
FordraidersAuthor Commented:
Thanks very much ...!! both work great.
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.