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

时间:2018-03-19 23:14:18

标签: excel vba excel-vba

我已经知道如何从其他工作簿复制特定列,但现在我还需要过滤特定列。我尝试过这段代码,但是我遇到了一个错误"下标超出了范围"。

我需要过滤包含" Mary"并复制其相应的数据。 这是我的代码示例,我知道我的语法有问题,特别是在为COLUMN C使用自动过滤器并复制不同的列并将其粘贴到另一个工作簿时。请帮我把它弄好。谢谢

    Sub RAWtransfertoTRUST()


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("Trust Activities Raw")
With TrackerSht
    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row 

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
 .AutoFilterMode = False
  .Range("B2:F").AutoFilter Field:=3, Criteria1:="Mary"
    lRw = .Cells(.Rows.Count, "B").End(xlUp).Row 


End With

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


With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "C").End(xlUp).Row 

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

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


                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("N1:Q" & lRw).Copy ' copy your range
End With

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



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("T1:W" & lRw).Copy ' copy your range
End With

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



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("Y1:Z" & lRw).Copy ' copy your range
End With

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


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("AB1:AC" & lRw).Copy ' copy your range
End With

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



End Sub

2 个答案:

答案 0 :(得分:2)

所以,这里有一些问题。

在此代码块中:

With FilterSht
    .AutoFilterMode = False
    .Range("B2:F").AutoFilter Field:=3, Criteria1:="Mary"
    lRw = .Cells(.Rows.Count, "B").End(xlUp).Row 
End With

您缺少B2:F范围内的数字。如果您要过滤整个列,那么您应该从B2中排除数字“2”。我假设您想要使用实际位于下一行的lRw,所以这需要高于您的范围行,然后您需要将其包含在您的{ {1}}添加B2:F

该行现在应该如下:

& lRw

此外,请注意,此不是,包括自动筛选器中的第2行。我假设您想要过滤第2行,因此如果是这种情况,您需要将其更改为.Range("B2:F" & lRw).AutoFilter Field:=2, Criteria1:="Mary"

下一期是您的复制/粘贴方法。你没有粘贴任何东西,因为你从未复制过它。在相同的使用块中,您可以添加以下行:B1:

这是你的最终结果:

.AutoFilter.Range.Copy

哦,我稍微清理了你的代码格式:D

答案 1 :(得分:1)

感谢您的帮助,我已经解决了我的问题。我只是过滤所有列,然后删除我不需要的列。这是我的示例代码。

    Sub RAWtransfertoTRUST()

    Dim MainWorkfile As Workbook, OtherWorkfile As Workbook
    Dim TrackerSht As Worksheet, FilterSht As Worksheet
    Dim lRow As Long, lRw As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set MainWorkfile = ActiveWorkbook
    Set TrackerSht = MainWorkfile.Sheets("Trust Activities Raw")

    With TrackerSht
        lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With

    Application.AskToUpdateLinks = False

    Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename)
    Set FilterSht = OtherWorkfile.Sheets("Raw Data")

    With FilterSht
        .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "C").End(xlUp).Row
        .Range("B1:W" & lRw).AutoFilter Field:=2, Criteria1:="Mary"
        .AutoFilter.Range.Copy

      End With

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


    With TrackerSht
    .Range("G:I,K:M,R:S,X:AD").DELETE Shift:=xlToLeft

     .Range("E:E").Copy
     .Range("G:O").PasteSpecial Paste:=xlPasteFormats
     .Range("G2", "G1000").NumberFormat = "dd/mm/yyyy"
     .Range("M2", "M1000").Interior.ColorIndex = 41
     .Range("J2", "J1000").Interior.ColorIndex = 6


    End With


    End Sub