Excel VBA: 如何合并来自不同工作簿的特定工作表？

Question

我对 VBA 还是很陌生，正在尝试合并来自不同工作簿的某些工作表。

例如：

我有一个名为 "One" 的工作簿，其中包含多个工作表 (A、B、C、D)。
我有另一个名为 "Two" 的工作簿，其中包含多个工作表（E、F、G、H）。

我想从工作簿一中取出工作表 A，从工作簿二中取出工作表 F 和 G。我希望将这些不同的工作表放在一个名为 "Three."

的新工作簿中

我在工作表 A 和 F 中的字段格式完全相同，所以我也希望合并这两个工作表，并在包含 A 数据的单元格完成后将 F 数据放在 A 数据下的相同字段中.

谁能帮我写下这段代码？
如果有人也有任何初学者的 VBA 链接，我们将不胜感激。

Answer 1

看例子：

'enforce declaration of variables 
Option Explicit

Sub CombineWorkbooks()
Dim sWbkOne As String, sWbkTwo As String
Dim wbkOne As Workbook, wbkTwo As Workbook, wbkThree As Workbook
Dim wshSrc As Worksheet, wshDst As Worksheet

On Error GoTo Err_CombineWorkbooks

'get the path
sWbkOne = GetWbkPath("Open workbook 'One'")
sWbkTwo = GetWbkPath("Open workbook 'Two'")
'in case of "Cancel"
If sWbkOne = "" Or sWbkTwo = "" Then
    MsgBox "You have to open two workbooks to be able to continue...", vbInformation, "Information"
    GoTo Exit_CombineWorkbooks
End If

'open workbooks: 'One' and 'Two'
Set wbkOne = Workbooks.Open(sWbkOne)
Set wbkTwo = Workbooks.Open(sWbkTwo)
'create new one - destination workbook
Set wbkThree = Workbooks.Add

'define destination worksheet
Set wshDst = wbkThree.Worksheets(1)

'start copying worksheets
'A
Set wshSrc = wbkOne.Worksheets("A")
wshSrc.UsedRange.Copy wshDst.Range("A1")
'F
Set wshSrc = wbkTwo.Worksheets("F")
wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)
'G
Set wshSrc = wbkTwo.Worksheets("G")
wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)

'done!

Exit_CombineWorkbooks:
    On Error Resume Next
    Set wbkThree = Nothing
    If Not wbkTwo Is Nothing Then wbkTwo.Close SaveChanges:=False
    Set wbkTwo = Nothing
    If Not wbkOne Is Nothing Then wbkOne.Close SaveChanges:=False
    Set wbkOne = Nothing
    Set wshDst = Nothing
    Set wshSrc = Nothing
    Exit Sub

Err_CombineWorkbooks:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CombineWorkbooks


End Sub


Function GetWbkPath(ByVal initialTitle) As String
Dim retVal As Variant

retVal = Application.GetOpenFilename("Excel files(*.xlsx),*.xlsx", 0, initialTitle, , False)
If CStr(retVal) = CStr(False) Then retVal = ""

GetWbkPath = retVal

End Function

注意：以上代码是临时写的，所以可能并不完美。

[EDIT2] 如果您想将数据复制到不同的工作表中，请将相应的代码替换为以下代码，但首先删除这些行：

'define destination worksheet
Set wshDst = wbkThree.Worksheets(1)

以后：

'start copying data 
'A
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "A"
Set wshSrc = wbkOne.Worksheets("A")
wshSrc.UsedRange.Copy wshDst.Range("A1")
'F
Set wshSrc = wbkTwo.Worksheets("F")
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "F"
wshSrc.UsedRange.Copy wshDst.Range("A1")
'G
Set wshSrc = wbkTwo.Worksheets("G")
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "G"
wshSrc.UsedRange.Copy wshDst.Range("A1")

祝你好运！

Excel VBA: 如何合并来自不同工作簿的特定工作表？

Excel VBA: How to combine specific worksheets from different workbooks?

excel

vba

worksheet

hssfworkbook