我需要一些帮助来修复我的语法。每当我尝试运行它时都会出现错误,说“下标超出范围”
我需要将工作表(“过滤数据”)中的列(“B:F”),(“J”),(N:Q),(S:V)复制到工作簿表(“2018年2月跟踪器” (原料)“)
当我删除所选列(“J”),(N:Q),(S:V)时,代码正在工作并从列B2:F2复制数据。
我知道我的语法有问题,但我无法弄清楚如何纠正它。请帮忙。
由于
Sub L4toMetrics()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim MainWorkfile As String
Dim OtherWorkfile As String
MainWorkfile = ActiveWorkbook.Name
lRow = Range("C1048576").End(xlUp).Row
Sheets("February 2018 Tracker (Raw)").Select
Range("B2:Q2" & lRow).ClearContents
Range("C1").Select
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Workbooks.Open Filename:=Application.GetOpenFilename
OtherWorkfile = ActiveWorkbook.Name
Sheets("Filtered Data").Select
If ActiveWorkbook.ActiveSheet.FilterMode Or _
ActiveWorkbook.ActiveSheet.AutoFilterMode Then _
ActiveWorkbook.ActiveSheet.AutoFilterMode = False
lRw = Range("C1048576").End(xlUp).Row
Range("B2:F2" & lRw).Select
Selection.Copy
Windows(MainWorkfile).Activate
Sheets("February 2018 Tracker (Raw)").Select
lstrw = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
Range("B" & lstrw).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(OtherWorkfile).Activate
Sheets("Filtered Data").Select
If ActiveWorkbook.ActiveSheet.FilterMode Or _
ActiveWorkbook.ActiveSheet.AutoFilterMode Then _
ActiveWorkbook.ActiveSheet.AutoFilterMode = False
lRw = Range("C1048576").End(xlUp).Row
Range("J2" & lRw).Select
Selection.Copy
Windows(MainWorkfile).Activate
Sheets("February 2018 Tracker (Raw)").Select
lstrw = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
Range("C" & lstrw).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(OtherWorkfile).Activate
Sheets("Filtered Data").Select
If ActiveWorkbook.ActiveSheet.FilterMode Or _
ActiveWorkbook.ActiveSheet.AutoFilterMode Then _
ActiveWorkbook.ActiveSheet.AutoFilterMode = False
lRw = Range("C1048576").End(xlUp).Row
Range("N2:Q2" & lRw).Select
Selection.Copy
Windows(MainWorkfile).Activate
Sheets("February 2018 Tracker (Raw)").Select
lstrw = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
Range("D" & lstrw).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(OtherWorkfile).Activate
Sheets("Filtered Data").Select
If ActiveWorkbook.ActiveSheet.FilterMode Or _
ActiveWorkbook.ActiveSheet.AutoFilterMode Then _
ActiveWorkbook.ActiveSheet.AutoFilterMode = False
lRw = Range("C1048576").End(xlUp).Row
Range("S2:O2" & lRw).Select
Selection.Copy
Windows(MainWorkfile).Activate
Sheets("February 2018 Tracker (Raw)").Select
lstrw = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
Range("D" & lstrw).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:1)
您过分依赖MACRO-Recorder,请尝试下面的代码复制>>粘贴第一部分(“B:F”列)。
您可以为其余列实现它。
Option Explicit
Sub L4toMetrics()
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("February 2018 Tracker (Raw)")
With TrackerSht
lRow = .Cells(.Rows.Count, "C").End(xlUp).Row ' last row with data in column "C"
.Range("B2:Q2" & 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("Filtered Data")
With FilterSht
If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
lRw = .Cells(.Rows.Count, "C").End(xlUp).Row ' last row with data in column "C"
.Range("B2:F" & lRw).Copy ' copy your range
End With
' paste
TrackerSht.Range("B" & lRow).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' implement it for the rest of your columns...
End Sub