Question

我有一个（希望）容易的情况。我正在寻求使用VBA宏自动执行此过程。

我有一个Excel电子表格（让我们称之为 data.xls ），它有多个带有以下名称的标签（这只是一个例子）：

Sucralose
Cellulose
Dextrose

每个标签中只有一列数据。我想知道是否有一种简单的方法可以将所有数据选项卡复制到另一个电子表格中，并使用特定格式进行进一步操作（让我们根据选项卡命名调用 reduction.xls ）。

例如：

我想在redu.xls [蔗糖，葡萄糖，纤维素]中复制标签Sucrose，Dextrose，Cellulose FROM data.xls的A列到相同命名标签（已存在）的F列。

我正在寻找一个“true / false”类型语句，其中data.xls中每个选项卡的列将粘贴到reduction.xls中，假设存在相同的命名选项卡，而不需要用户进行交互。

Answer 1

我个人会在单独的工作簿中创建VBA，您可以从其他2个交互工作簿中单独打开和执行。

因此我定义了三个维度。 wbk =包含代码的工作簿。 wbk1 =您要从中复制的源工作簿。 wbk2 - 要粘贴到的目标工作簿。

您必须编辑文件位置以及范围。假设您只想要A1：A100，前提是它每次都是相同的行数。如果不是，我建议将行增加到远超过您预期的行数，以确保您不会错过任何行。

转到新工作簿
按住Alt并按F11键
点击插入 - ＆gt;模块
在窗口中粘贴以下代码并根据需要更新文件位置和复制/粘贴范围

按下运行宏（绿色播放按钮）或用光标在代码

中按F5

 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

Answer 2

以下发布的代码具有以下功能：

准备好轻松处理任意数量的标签。您必须仅修改3行，如下所示：1）选项卡名称列表，2）源工作簿的名称，3）目标工作簿的名称。
对目标工作簿中缺少选项卡进行“保护”。
结构可能是不言自明的（虽然这可能是一个主观陈述）。

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根据多个文件中的选项卡名称复制/粘贴数据

2 个答案: