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

是的，这是我为您解决问题的尝试：

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个子目录中。可以将其分为2个子，这没有多大意义，因为您总是必须同时使用两个子。（bc第二个子节点将这样称呼：调用conso2（otherworkfile（2））因此您不能在没有输入变量的情况下使用第二个子。

Answer 2

这是我想出的代码，如果有人对我如何选择我的工作簿有任何其他想法，因为现在无论何时运行“ 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

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

2 个答案: