コピー貼り付けマクロ

Question

私は特定の値の列を検索するマクロを持っており、trueの場合、その値を含むすべての行を別のワークシートにコピーします。しかし、特定の値を持つすべての行ではなく、最後の行のみをコピーするので、動作しないようです。

基本的に、私はB列にデータを入力し、C列はVLOOKUPで結果を返し、D列はTRUE/FALSEを返します。 D列で値がTRUEになると、行全体がコピーされて別のシートに貼り付けられます。

Private Sub CommandButton21_Click() 
    Dim LR As Long 
    Dim C As Range 
    Dim Test As Worksheet 
    Dim Pastesheet As Worksheet 

    'Find the last row with data in column C 
    LR = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row 

    'look at every cell in D2 onwards 
    For Each C In Range("D2:D" & LR) 
     If C.Value = True Then 

      'Copy code 
      Set Test = Worksheets("Test Sheet") ' Copy From this sheet 
      Set Pastesheet = Worksheets("Inventory") ' to this sheet 

      C.EntireRow.Copy ' copy the row from column D that meets that requirements 
      Pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats   
     End If  
    Next C 
End Sub 

Answer 1

私はあなたが列Aに何も持っていないと思います。最後の行を見つけるために別の方法を使用してください。あなたのループが始まるときにあなたのスコープを締めてください。

これは動作するはずです：そのエラー@zshake

Private Sub CommandButton21_Click() 
    Dim LR As Long 
    Dim C As Range 
    Dim Test As Worksheet 
    Dim Pastesheet As Worksheet 
    Dim LastRowOnSheet As Long 

    'Find the last row with data in column C 
    LR = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row 

    'look at every cell in D2 onwards 

     Set Test = Worksheets("Test Sheet") ' Copy From this sheet 
     Set Pastesheet = Worksheets("Inventory") ' to this sheet 

    For Each C In Test.Range("D2:D" & LR).Cells 


    If C.Value = True Then '(you can actually type "if c.value then" but no difference) 

     'Copy code    

     LastRowOnSheet = Pastesheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 

     C.EntireRow.Copy 'copy the row from column D that meets that requirements 

     Pastesheet.Cells(LastRowOnSheet + 1, 1).PasteSpecial xlPasteValuesAndNumberFormats 

    End If 

    Next C 

    End Sub 

シートが定義されていませんでした示したり、シート全体が空白になっています。 findコマンドにエラーはありません。 pasteSheetが有効であることを確認するためのテスト。あなたがエラーを取得しているところ、上記のコードの1行でこれを置くことによってこれを行うことができます。

msgbox Pastesheet.name

ことは、シート名が表示されている場合は、あなたがシートに良いです。