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

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.

Answer 1

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

Answer 2

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