Excel copy/paste data based on tab names in multiple files

Question

I have a (hopefully) easy situation. I'm seeking to automate this process with a VBA macro.

I have an Excel spreadsheet (let's call this data.xls) that has multiple tabs with the following names (this is just an example):

Sucralose
Cellulose
Dextrose

Each tab simply has a column of data in it. I want to know if there is a simple way to copy all the tabs of data to another spreadsheet with specific formatting for further operations (let's call this reduction.xls) based on the tab naming.

For example:

I want to copy Column A of tab Sucrose, Dextrose, Cellulose FROM data.xls TO Column F of the same named tabs (already existing) in reduction.xls [Sucrose, Dextrose, Cellulose].

I'm looking for a "true/false" type statement where the column from each tab in data.xls will be pasted into reduction.xls assuming the same exact named tab exists, without any need for interaction from the user.

Mitch · Answer 1 · 2015-01-17T00:01:55.363

Personally I would create the VBA in a separate workbook that you can open and execute separately from the other 2 interacting workbooks.

Thus I defined three dimension. wbk = workbook with code in it. wbk1 = the source workbook where you will copy from. wbk2 - the destination workbook where you will paste to.

You will have to edit the file locations as well as the Ranges. Say if you only wanted A1:A100, provided it is the same number of rows each time. If not I suggest increasing the rows far past what you anticipate the row count will be so you make sure you don't miss any.

Go to a new workbook
Hold Alt and press F11 key
Click Insert -> Module
Paste the below code in the window and update file locations and copy/paste range as needed

Press Run Macro (green play button) or hit F5 with your cursor in the code

 Sub DataTransfer()

 Dim wbk, wbk1, wbk2 As Workbook

    'Workbook with VBA in it.
    Set wbk = ActiveWorkbook

    'Define destination workbook
    Set wbk1 = Workbooks.Open("C:\data.xls")
    'Define Source workbook
    Set wbk2 = Workbooks.Open("C:\reduction.xls")




    Call wbk1.Worksheets("Sucralose").Range("A1:A100000").Copy
    Call wbk2.Worksheets("Sucralose").Range("F1:F100000").PasteSpecial(xlPasteValues)
    Application.CutCopyMode = False


    Call wbk1.Worksheets("Cellulose").Range("A1:A100000").Copy
    Call wbk2.Worksheets("Cellulose").Range("F1:F100000").PasteSpecial(xlPasteValues)
    Application.CutCopyMode = False


    Call wbk1.Worksheets("Dextrose").Range("A1:A100000").Copy
    Call wbk2.Worksheets("Dextrose").Range("F1:F100000").PasteSpecial(xlPasteValues)
    Application.CutCopyMode = False

    End Sub

score 0 · Accepted Answer · answered Jan 17 '15 at 10:13

Code posted below has the following features:

It is prepared for easily handling an arbitrary number of tabs. You have to modify only 3 lines, as indicated: 1) The list of tab names, 2) the name of the source workbook, 3) the name of the target workbook.
It is "protected" against missing tabs in the target workbook.
The structure is likely self-explanatory (although this might be a subjective statement).

.

Sub copy_tab(ByVal wsName As String)
    Dim wbnamesrc As String
    Dim wbnametrg As String
    wbnamesrc = "source.xlsm"      ' Change this line
    wbnametrg = "Book8"      ' Change this line
    Dim wbsrc As Workbook
    Dim wbtrg As Workbook
    Set wbsrc = Workbooks(wbnamesrc)
    Set wbtrg = Workbooks(wbnametrg)

    If (WorksheetExists(wsName, wbnametrg)) Then
        Dim rngsrc As Range
        Dim rngtrg As Range
        Application.CutCopyMode = False
        wbsrc.Worksheets(wsName).Range("A:A").Copy
        wbtrg.Worksheets(wsName).Range("A:A").PasteSpecial
    End If
End Sub

Sub copy_tabs()
    Dim wslist As String
    Dim sep As String
    wslist = "Sucralose|Cellulose|Dextrose|Sheet1"      ' Change this line
    sep = "|"
    Dim wsnames() As String
    wsnames = Split(wslist, sep, -1, vbBinaryCompare)

    Dim wsName As String
    Dim wsnamev As Variant
    For Each wsnamev In wsnames
        wsName = CStr(wsnamev)
        Call copy_tab(wsName)
    Next wsnamev
End Sub

Public Function str_split(str, sep, n) As String
' From http://superuser.com/questions/483419/how-to-split-a-string-based-on-in-ms-excel
' splits on your choice of character and returns the nth element of the split list.
    Dim V() As String
    V = Split(str, sep)
    str_split = V(n - 1)
End Function

' From http://stackoverflow.com/a/11414255/2707864
Public Function WorksheetExists(ByVal wsName As String, ByVal wbName As String) As Boolean
    Dim ws As Worksheet
    Dim ret As Boolean
    ret = False
    wsName = UCase(wsName)
    For Each ws In Workbooks(wbName).Worksheets
        If UCase(ws.Name) = wsName Then
            ret = True
            Exit For
        End If
    Next
    WorksheetExists = ret
End Function

Excel copy/paste data based on tab names in multiple files

2 Answers2