如何合并此代码?

时间:2016-06-23 18:46:52

标签: excel vba

基本上我是从A列过滤掉4个单独的数字并将该数据复制到另一张表中,但这段代码看起来非常繁琐,我需要确保行是偏移的,这样数据就不会丢失。

Sheets("BS").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1226*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("BS Regulated Entities").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Selection.PasteSpecial _
    Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("BS").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1843*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("BS Regulated Entities").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Selection.PasteSpecial _
    Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("BS").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*865*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("BS Regulated Entities").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Selection.PasteSpecial _
    Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("BS").Select
Range("A1").AutoFilter Field:=1, Criteria1:= _
    "*1223*"
ActiveSheet.AutoFilter.Range.Copy
Sheets("BS Regulated Entities").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select
Selection.PasteSpecial _
    Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Application.CutCopyMode = False

2 个答案:

答案 0 :(得分:0)

据我所知,您正在查看列A并查看它是否具有某些值,如果是,则将它们粘贴到原始数据集之下。它是否正确?如果是这样,您可以编写一个循环来检查该数据并跟踪它应该与变量一起使用的行。现在,我正在考虑这样的事情

finalRow = Cells(Rows.Count,1).end(xlup).row
nextRow = 1 'or wherever you want to start placing the data
for i = 1 to finalRow
    if cells(i, 1) = "*1226*" or cells(i, 1) = "*1843*" or ... then 'you get the idea
        for j = 1 to 10 'or whatever your last column happens to be
            Worksheets("BS Regulated Entity").cells(nextRow, j) = cells(i, j)
        next j
        nextRow = nextRow + 1
    end if
next i

这更紧凑,更容易阅读。该代码假定您已经在Worksheets("BS")。无需选择它。希望我能正确理解你的情况。

答案 1 :(得分:0)

为什么不一次过滤所有四个数字:

With Sheets("BS")
    .Range("A1").AutoFilter Field:=1, Criteria1:=Array("*1226*", "*1843*", "*865*", "*1223*"), Operator:=xlFilterValues
    .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
End With

With Sheets("BS Regulated Entities")
    .Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulas
End With