VBA-将特定列复制到工作簿中的工作表

时间:2018-03-18 13:10:12

标签: excel vba excel-vba

我需要一些帮助来修复我的语法。每当我尝试运行它时都会出现错误,说“下标超出范围”

我需要将工作表(“过滤数据”)中的列(“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

1 个答案:

答案 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