複数のタブの行を条件に基づいて1つに統合するExcel VBAスクリプト

Question

Excelブックは、すべて同じ構造の複数のシートで構成されています。私は、列238に「はい」と記載されているすべてのデータをまとめワークシートに統合したいと考えています。理想的には、この基準が満たされている完全な行ではなく、特定の列のみをコピーします。

私は基礎としてこのコードを持っている：

Sub CopyRangeFromMultiWorksheets() 
Dim sh As Worksheet 
Dim DestSh As Worksheet 
Dim Last As Long 
Dim CopyRng As Range 

With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

' Delete the summary sheet if it exists. 
Application.DisplayAlerts = False 
On Error Resume Next 
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete 
On Error GoTo 0 
Application.DisplayAlerts = True 

' Add a new summary worksheet. 
Set DestSh = ActiveWorkbook.Worksheets.Add 
DestSh.Name = "RDBMergeSheet" 

' Loop through all worksheets and copy the data to the 
' summary worksheet. 
For Each sh In ActiveWorkbook.Worksheets 
    If sh.Name <> DestSh.Name Then 

     ' Find the last row with data on the summary worksheet. 
     Last = LastRow(DestSh) 

     ' Specify the range to place the data. 
     Set CopyRng = sh.Range("A1:G1") 

     ' Test to see whether there are enough rows in the summary 
     ' worksheet to copy all the data. 
     If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then 
      MsgBox "There are not enough rows in the " & _ 
       "summary worksheet to place the data." 
      GoTo ExitTheSub 
     End If 

     ' This statement copies values and formats from each 
     ' worksheet. 
     CopyRng.Copy 
     With DestSh.Cells(Last + 1, "A") 
      .PasteSpecial xlPasteValues 
      .PasteSpecial xlPasteFormats 
      Application.CutCopyMode = False 
     End With 

     ' Optional: This statement will copy the sheet 
     ' name in the H column. 
     DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name 

    End If 
Next 

ExitTheSub: 

Application.Goto DestSh.Cells(1) 

' AutoFit the column width in the summary sheet. 
DestSh.Columns.AutoFit 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 
End Sub 

これは、ワークシート全体をコピーしています。私は条件に一致する特定の行だけが各シートからコピーされることを実装したいと思います。

編集：上記のコードは私が見つけたコードです。私は、指定された範囲をコピーする部分を、条件に合った各シートの行のみをコピーするループまたはフィルタで置き換えたいとします（この場合、値が "yes"と "no"の列で、それはイエスと言う行をコピーして、統合シート（RDBMergeSheet）の助けを

おかげ

Answer 1

あなたの質問にそれらを貼り付け：！私は、Excelワークブックがすべて同じに構成されている複数のシートからなるがあります。私は、列238に「はい」と表示されているすべてのデータをまとめワークシートに集約したいと考えています。

回答： このような行を削除する方がはるかに簡単ですはいセルはありません。それはすべてのシートをコンパイルした後です。したがって、要約シートの各シートからすべての行と列をコンパイルしたと仮定します。

Sub Delete_all_non_yes() 
    Sheets("Summary").Select 
    Dim checked_cell As Integer 
    Dim NB_rows As Integer 
    ActiveCell.SpecialCells(xlLastCell).Select 
    NB_rows = ActiveCell.Row 
    Dim Checked_cell_value As String 
    checked_cell = 1 
    Do While checked_cell <= NB_rows 
    Checked_cell_value = Cells(checked_cell, 278) 
    If Not Checked_cell_value = "Yes" Then 
     'checks each row for the value "Yes" 
     Rows(checked_cell).Delete 
    Else 
     checked_cell = checked_cell + 1 
    End If 

    Loop 

End Sub 

次に、同じロジックを使用して、探している列を削除できます。 もっと効率的な方法がたくさんありますが、これで作業が完了します。

注：私の最初のstackoverflow Ans！フィードバックは大歓迎です。