从多个工作簿复制具有不同列和工作表名称的数据 - VBA

Question

您好，我尝试为我的问题寻找可能的解决方案，但找不到我需要的确切代码。

我需要从具有不同工作表名称和不同列的两个不同工作簿中复制数据。我在从单个工作簿复制数据时使用了我的代码，但出现错误提示

“自动化错误”。

所以我需要做的是将工作表名称Raw Data 和Arm Checklist 中的数据复制到我的主工作表也命名为Raw Data。

我需要从Raw Data 复制的列来自A7:Q，而复制到Arm Checklist 的列来自C3:D,G,E,H:J,K,M:Q。此列中的数据需要合并到我的 MainWorkfile Raw Data

Sub SAMPLE()        
    Dim MainWorkfile As Workbook
    Dim OtherWorkfile As Workbook
    Dim OtherWorkfile2 As Workbook
    Dim TrackerSht As Worksheet
    Dim FilterSht As Worksheet
    Dim FilterSht2 As Worksheet

    Dim lRow As Long, lRw As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' set workbook object
    Set MainWorkfile = ActiveWorkbook

    ' set the worksheet object
    Set TrackerSht = MainWorkfile.Sheets("Raw Data")
    With TrackerSht
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"
        .Range("A7:S7" & lRow).ClearContents
    End With


    Application.AskToUpdateLinks = False

    ' set the 2nd workbook object
    Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename)

    ' set the 2nd worksheet object
    Set FilterSht = OtherWorkfile.Sheets("Raw Data")

    With FilterSht
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("A7:Q" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("A7:Q" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    OtherWorkfile.Close

    Set OtherWorkfile2 = Workbooks.Open(Filename:=Application.GetOpenFilename)

    ' set the 2nd worksheet object
    Set FilterSht2 = OtherWorkfile.Sheets("Arm Checklist")

    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("C3:D" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("A:B" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    ' implement it for the rest of your columns...
    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("G3:G" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("C7:C" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False


    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("E3:E" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("E7:E" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("H3:J" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("F7:H" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    OtherWorkfile2.Close



End Sub

Answer 1

这是我提出的代码，如果有人对我如何选择我的工作簿有任何其他想法，因为现在每当我运行它时，“Workbooks.Open(Filename:=Application.GetOpenFilename)” 我需要选择两次才能选择我需要合并的两个工作簿。

Sub conso1()

Dim MainWorkfile As Workbook
Dim OtherWorkfile2 As Workbook
Dim TrackerSht As Worksheet
Dim FilterSht2 As Worksheet

Dim lRow As Long, lRw As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' set workbook object
Set MainWorkfile = ActiveWorkbook

' set the worksheet object
Set TrackerSht = MainWorkfile.Sheets("Raw Data")
With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With


Application.AskToUpdateLinks = False


On Error GoTo ErrHand:
'Set OtherWorkfile2 = Workbooks.Open(Filename:=Application.GetOpenFilename)
currentPath = Application.ActiveWorkbook.Path
Set OtherWorkfile2 = Workbooks.Open(currentPath & "\OtherWB2.xls")

' set the 2nd worksheet object
Set FilterSht2 = OtherWorkfile2.Sheets("Arm Checklist")


With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("C3:D" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A7:B" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' implement it for the rest of your columns...
With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("G3:G" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("C7:C" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("E3:E" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("E7:E" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("H3:J" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("F7:H" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("K3:K" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("L7:L" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("M3:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("M7:Q" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

OtherWorkfile2.Close

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "You Choose to Cancel"
        Err.clear
    Else
        Debug.Print Err.Description

    End If


Call conso2

End Sub


Sub conso2()

Dim MainWorkfile As Workbook
Dim OtherWorkfile As Workbook
Dim TrackerSht As Worksheet
Dim FilterSht As Worksheet

Dim lRow As Long, lRw As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' set workbook object
Set MainWorkfile = ActiveWorkbook

' set the worksheet object
Set TrackerSht = MainWorkfile.Sheets("Raw Data")
With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With


Application.AskToUpdateLinks = False

On Error GoTo ErrHand:
'Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename)
currentPath = Application.ActiveWorkbook.Path
Set OtherWorkfile = Workbooks.Open(currentPath & "\OtherWB.xls")
Set FilterSht = OtherWorkfile.Sheets("Raw Data")

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("A7:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


OtherWorkfile.Close

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "You Choose to Cancel"
        Err.clear
    Else
        Debug.Print Err.Description

    End If


End Sub

Answer 2

哟，所以这是我试图解决你的问题：

Sub conso()

Dim MainWorkfile As Workbook
Dim myFiles As Variant
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim OtherWorkfile(1 To 2) As Workbook
Dim CorrectionHandler(1 To 2) As Workbook
Dim TrackerSht As Worksheet
Dim FilterSht As Worksheet

Dim i As Integer

Dim lRow As Long, lRw As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

' set workbook object
Set MainWorkfile = ThisWorkbook

' set the worksheet object
Set TrackerSht = MainWorkfile.Sheets("Raw Data")
With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With

On Error GoTo ErrHand

TryAgain:
myFiles = Application.GetOpenFilename(MultiSelect:=True)

If UBound(OtherWorkfile) > 2 Then
    MsgBox "Too many WBs selected"
    GoTo TryAgain
End If

For i = LBound(myFiles) To UBound(myFiles)
    Set OtherWorkfile(i) = Workbooks.Open(myFiles(i))
Next i
'Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename())
'currentPath = Application.ActiveWorkbook.Path
'Set OtherWorkfile = Workbooks.Open(currentPath & "\OtherWB2.xls")


On Error GoTo correction
GoTo jumper
correction:
Set CorrectionHandler(2) = OtherWorkfile(1)
Set CorrectionHandler(1) = OtherWorkfile(2)
Set OtherWorkfile(1) = CorrectionHandler(1)
Set OtherWorkfile(2) = CorrectionHandler(2)
On Error GoTo ErrHand
jumper:

' set the 2nd worksheet object
Set FilterSht = OtherWorkfile(1).Sheets("Arm Checklist")

On Error GoTo ErrHand

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("C3:D" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A7:B" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' implement it for the rest of your columns...
With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("G3:G" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("C7:C" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("E3:E" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("E7:E" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("H3:J" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("F7:H" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("K3:K" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("L7:L" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("M3:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("M7:Q" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

OtherWorkfile(1).Close
'----------------------------2nd Workbook-------------------------------------

With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With


Application.AskToUpdateLinks = False

'Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename)
'currentPath = Application.ActiveWorkbook.Path
'Set OtherWorkfile = Workbooks.Open(currentPath & "\OtherWB.xls")
Set FilterSht = OtherWorkfile(2).Sheets("Raw Data")

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("A7:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

OtherWorkfile(2).Close

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "You Choose to Cancel"
        Err.Clear
    Else
        Debug.Print Err.Description

    End If


Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

End Sub

如您所见，现在一切都在 1 个 sub 中。 可以将它分成 2 个潜艇，这没有多大意义，因为您总是必须使用两个潜艇。 （bc 2nd sub 会这样调用： 调用 conso2(otherworkfile(2)) 所以你不能使用没有输入变量的第二个子。