Excel VBAセルに特定のテキストが含まれるまでセルの範囲を選択

Question

名前のワークシート（下のコードのDion）を検索し、Dionという名前の行を別のワークシートにコピーできました。ただし、宛先ワークシートには、ソース・ワークシート内のテキストの最後の列に隣接する列のテキストが含まれている場合があります。

私はDionを含む行から特定のテキストを含むセルで終わる選択範囲を持つセルの範囲を選択できます。

If Cells(...).Value = "Dion" Thenを If Range("A1:CS1000")...に変更しようとしましたが、タイプミスマッチエラーが発生しました。

ここに私のVBAコードです。私はそれはおそらく非常に非効率的だけど、それは私が仕事作ることができたものです：あなたの助けを

Dim r As Long 
Dim endRow As Long 
Dim pasteRowIndex As Long 

Worksheets("Tracking").Activate 

endRow = 500 
pasteRowIndex = 1 

For r = 6 To endRow 

    If Cells(r, Columns("BM").Column).Value = "Dion" Then 

     Rows(r).Select 
     'Code above shoud select all cells from Rows(r) until a cell contains the text "End" 
     Selection.Copy 

     Worksheets("Dion").Select 
     Rows(pasteRowIndex + 5).Select 
     ActiveSheet.Paste 

     pasteRowIndex = pasteRowIndex + 1 

     Worksheets("Tracking").Select 

    End If 

Next r 

感謝。

Answer 1

あなただけの「終わり」の値を含む1までの列であることを行のコピーを制限しようとしている場合は、次のコードは動作するはずです：

Dim r As Long 
Dim endRow As Long 
Dim pasteRowIndex As Long 
Dim endCell As Range 

'Use With block so that we can write '.' instead of 'Worksheets("Tracking").' 
With Worksheets("Tracking") 

    endRow = 500 
    pasteRowIndex = 1 

    For r = 6 To endRow 
     'Always qualify 'Cells', 'Range', 'Columns' and 'Rows' objects so that we 
     'know what sheet we are referring to 
     'Also, as pointed out by A.S.H, ' Columns("BM").Column ' can be 
     'shortened to ' "BM" ' 
     If .Cells(r, "BM").Value = "Dion" Then 
      'Find, in the current row, the location of the first cell containing "End" 
      'Note: If you want to search for the word "End" by itself, rather than just 
      '"End" within the cell (e.g. in the value "Endymion"), change "xlPart" to 
      '"xlWhole" 
      Set endCell = .Rows(r).Find(What:="End", LookIn:=xlValues, LookAt:=xlPart, After:=.Cells(r, "A")) 
      If endCell Is Nothing Then 
       'If no "End" found, copy the entire row 
       .Rows(r).Copy Worksheets("Dion").Rows(pasteRowIndex + 5) 
      Else 
       'If "End" found, copy from column A to the cell containing "End" 
       'Note: I have assumed you don't want to copy the "End" cell itself 
       .Range(.Cells(r, "A"), endCell.Offset(0, -1)).Copy Worksheets("Dion").Rows(pasteRowIndex + 5).Cells(1, "A") 
      End If 

      pasteRowIndex = pasteRowIndex + 1 

     End If 

    Next r 
End With