从多个工作簿复制具有不同列和 sheet 名称的数据 - VBA
Copying data with different columns and sheet name from multiple workbooks - VBA
您好,我尝试为我的问题寻找可能的解决方案,但找不到我需要的确切代码。
我需要从两个不同的工作簿中复制数据,这些工作簿具有不同的工作sheet名称和不同的列。我在从单个工作簿复制数据时使用了我的代码,但出现
错误
"Automation error".
所以我需要做的是将sheet名称Raw Data
和Arm Checklist
中的数据复制到我的主要工作sheet也命名为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
这是我想出的代码,如果有人对我如何选择我的工作簿有任何其他想法,因为现在每当我 运行 它 "Workbooks.Open(Filename:=Application.GetOpenFilename)"
我需要选择两次才能 select 我需要合并的两个工作簿。
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
哟,这是我解决你问题的尝试:
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 个潜艇,这没有多大意义,因为您总是必须使用两个潜艇。 (公元前第二个子会这样称呼:
调用 conso2(otherworkfile(2))
所以你不能使用第二个子 w/o inputvar.
您好,我尝试为我的问题寻找可能的解决方案,但找不到我需要的确切代码。
我需要从两个不同的工作簿中复制数据,这些工作簿具有不同的工作sheet名称和不同的列。我在从单个工作簿复制数据时使用了我的代码,但出现
错误"Automation error".
所以我需要做的是将sheet名称Raw Data
和Arm Checklist
中的数据复制到我的主要工作sheet也命名为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
这是我想出的代码,如果有人对我如何选择我的工作簿有任何其他想法,因为现在每当我 运行 它 "Workbooks.Open(Filename:=Application.GetOpenFilename)" 我需要选择两次才能 select 我需要合并的两个工作簿。
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
哟,这是我解决你问题的尝试:
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 个潜艇,这没有多大意义,因为您总是必须使用两个潜艇。 (公元前第二个子会这样称呼: 调用 conso2(otherworkfile(2)) 所以你不能使用第二个子 w/o inputvar.