このコードを統合するにはどうすればよいですか？

Question

基本的には、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 

Answer 1

もしそうなら、あなたは元のデータセットの下にそれらを貼り付け、コラム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")にいることを前提としています。それを選択する必要はありません。うまくいけば私はあなたの状況を正しく理解しています。

Answer 2

理由だけではなく、一度にすべての4つの数字をフィルタリングしない：

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