Excelマクロ：あるワークシートの行の値を条件に基づいて別のワークシートの特定の場所にコピー

Question

私はExcelで約4ヶ月間マクロで作業していましたが、基本的には既存のコードを見つけ出し、使い方。私はちょっと立ち往生しています。

Excelワークブックにレポートがあります。列Dに表示されるデータに基づいて、同じワークブック内の複数のワークシートにデータをコピーする必要があります。つまり、列Dが特定の基準に一致する行全体をコピーする必要があります。元のワークシートには数式が含まれていますが、データがコピーされたときにのみ値が表示されます。

私は全体のデータをコピーすることができましたが、私は二つの問題があります 1）式は、値だけでなく 2）のデータは、セルA2で新しいワークシートに表示され、全体でコピーしているが、私は必要セルA5から開始する

メインレポートを毎月実行して分割する必要があるため、これをテンプレートとして設定していますので、コピー元の範囲は一定ではありません。これは私が現在使用しているコードのサンプルです：

Sub RefreshSheets() 

    Sheets("ORIGIN").Select 
    Dim lr As Long, lr2 As Long, r As Long 
    lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row 
    lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 

    For r = lr To 2 Step -1 
     If Range("D" & r).Value = "movedata" Then 
      Rows(r).Copy Destination:=Sheets("DESTINATION").Range("A" & lr2 + 1) 
      lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 
     End If 


    Next r 

    End Sub 

私は「.PasteSpecial貼り付け：= xlPasteValues」を追加しようとしている「.Range（ 『』 & LR2 + 1）」の後、私は取得しますコンパイルエラー（期待される：文の終わり）。私は明らかな何かを見逃してしまったと確信しています（これは私がまだ完全に理解していないコードを使って得たものです）。しかし、これまでに試したことはありませんでした。

アドバイスをいただければ幸いです。

Answer 1

最初のバージョンは、Forループ

Option Explicit 

Public Sub RefreshSheets() 
    Dim wsO As Worksheet, wsD As Worksheet, lrO As Long, lrD As Long, r As Long 

    Set wsO = ThisWorkbook.Sheets("ORIGIN") 
    Set wsD = ThisWorkbook.Sheets("DESTINATION") 
    lrO = wsO.Cells(Rows.Count, "A").End(xlUp).Row 
    lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row 

    If lrD < 5 Then lrD = 5 

    For r = lrO To 2 Step -1 
     If wsO.Range("D" & r).Value2 = "movedata" Then 
      wsO.Rows(r).Copy 
      wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues 
      lrD = lrD + 1 
     End If 
    Next 
End Sub 

---

これを（それは、多数の行に遅くなることがあります）を使用していますバージョンでは、オートフィルタを使用して、 "movedata"を含むすべての行を一度にコピーします。

Public Sub RefreshSheetsFast() 
    Dim wsO As Worksheet, wsD As Worksheet, lrD As Long 

    Set wsO = ThisWorkbook.Sheets("ORIGIN") 
    Set wsD = ThisWorkbook.Sheets("DESTINATION") 
    lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row 

    If lrD < 5 Then lrD = 5 'Makes sure the first row on DESTINATION sheet is >=5 

    If Not wsO.AutoFilter Is Nothing Then wsO.UsedRange.AutoFilter 
    With wsO.UsedRange 
     .Columns(4).AutoFilter Field:=1, Criteria1:="movedata" 
     .Offset(1).Resize(.Rows.Count - 1).Copy  'Excludes the header (row 1) 
    End With 
    wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues 

    Application.CutCopyMode = False 
    wsO.UsedRange.AutoFilter 'Removes the "movedata" filter 
End Sub 

Answer 2

コピーを実行し、二つの別々の要求として貼り付けます。

Sub RefreshSheets() 
    Sheets("ORIGIN").Select 
    Dim lr As Long, lr2 As Long, r As Long 
    lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row 
    lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 

    For r = lr To 2 Step -1 
     If Range("D" & r).Value = "movedata" Then 
      Rows(r).Copy 
      Sheets("DESTINATION").Range("A" & lr2 + 1).PasteSpecial xlPasteValues 
      lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 
     End If 
    Next r 
End Sub