VBA次の空の行に行をコピーして貼り付けます

Question

「レポート」と呼ばれるシートから同じ行の情報をコピーするマクロを作成しようとしています（数字が明らかに変わります）。最初の行にヘッダーがあります。次の空行に貼り付ける値を取得しようとしていますが、正しく動作するようには見えません。

さまざまな質問からいくつかのコードをまとめて試してみることができませんでした。ここで

は私のコードは次のとおりです。あなたの助けのために再び

Sub Insert_Data() 
' 
' Insert_Data Macro 
Sheets("Report").Range("B9:F9").Copy 
Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues, 
Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
End Sub 
Sub PSData_Transfer() 

Sheets("Report").Range("B9:F9").Copy 

Dim lastrow As Long 
lastrow = Sheets("Data").Range("A65536").End(xlUp).Row 

Sheets("Data").Activate 
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 


End Sub 

ありがとう！

Answer 1

コードを少し修正する必要があるかもしれませんが、自分の現在のワークシートで使用しているものを自由に使用してください。

Sub Insert_Data() 

    For R = LR To 2 Step -1 ' Change the 2 in "To 2" to the row just below your header, 
           ' but typically row 2 is the second cell under header anyways 
     Call CopyTo(Worksheets(2).Range("B" & R & ":C" & R), Worksheets(1)Range("A:B")) 
    Next R 

End Sub 

Private Function CopyTo(rngSource As Range, rngDest As Range) 

    LR = rngDest.cells(Rows.Count, 1).End(xlUp).row 

    rngDest.cells(LR + 1, 1).value = rngSource.cells(1, 1).value 
    rngDest.cells(LR + 1, 2).value = rngSource.cells(1, 2).value 

End Function 

私はそれが遅いとコピー方法を使用することを好きではない、それはあなたの第二の唯一の値