VBAはVBAの

Question

神、

は私が欲しいと実行するためにアマチュア-VBA（この場合、私は素人です）のこの作品を微調整するために、すべての午前しようとしている別のワークシートにX（変数）の行をコピーします。

以下は現在の説明です。ブック内の3番目のシートの列Oにセルの値1が表示されます。ヒットしたら、Column Oの1を持つ行を "Blad1"という新しいワークシートにコピーします。その後、ブック「Doorvoeren」の3枚目のシートに戻ります。

これはループし、必要なタスクを実行しますが、シート "Doorvoeren"の変数に基づいて行をコピーするだけです。この値が5の場合は、列Oに1を、行に4行をコピーする必要があります。 （例として）。

ここに私を正しい方向に送ってください。それを働かせようとするが、その過程でそれから学ぶ。

私のコードは、以下のサンプルに追加されます。

Sub testIt() 
Dim r As Long, endRow As Long, pasteRowIndex As Long 

endRow = 500 
pasteRowIndex = 5 

For r = 3 To endRow 

    If Cells(r, Columns("O").Column).Value = 1 Then 
      Rows(r).Select 
      Selection.Copy 
      Sheets("Blad1").Select 
      Rows(pasteRowIndex).Select 
      ActiveSheet.Paste 
      pasteRowIndex = pasteRowIndex + 1 
      Sheets("Doorvoeren").Select 
    End If 
Next r 
End Sub 

EDIT：実際に動作するものを見つけるために、実際の問題が発生した、あなたの答えありがとうございました。もう一度説明する。私はこのVBAを、シート "Doorvoeren"のセルQ3を見て、コピーする行の数を得る方法で調整する必要があります。したがって、Q3がセル値である場合、 5、私はそれがシート "Doorvoeren"の列Oの番号1の行をコピーするだけでなく、その下の他の4行をコピーします。

私の1列目は単なるマーカーであり、コピーしたい行数ではありません。 私が完全にはっきりしていないかどうか聞いてください/私に教えてください。

Answer 1

は、私はあなたの説明の際にわずかな変更を行った私の解決策（少し注釈を使用してコードをammending）

Sub testIt() 

'add another variable (called var) 

Dim r As Long, endRow As Long, pasteRowIndex As Long, Var As Long 

endRow = 500 
pasteRowIndex = 5 

For r = 3 To endRow 

    If Cells(r, Columns("O").Column).Value = 1 Then 

'Grab the var number from the Doorvoeren sheet. Var will then determine how many rows need to be copied in each circumstance 

      Sheets("Doorvoeren").Select 
      Var = Cells(r, Columns("Q").Column).Value 

      Rows(r & ":" & r + (Var - 1)).Select 
      Selection.Copy 
      Sheets("Blad1").Select 
      Rows(pasteRowIndex).Select 
      ActiveSheet.Paste 
      pasteRowIndex = pasteRowIndex + Var 
      Sheets("Doorvoeren").Select 

    End If 

Next r 

End Sub 

Answer 2

SelectとActiveSheetを使用しないで、代わりに参照されるシートと範囲を使用することをお勧めします。ここで

Option Explicit 

Sub testIt() 

Dim r As Long, endRow As Long, pasteRowIndex As Long 
Dim PasteRow As Long 

With Sheets("Doorvoeren") 
    ' find last row with data in Column "O" in "Doorvoeren" sheet 
    endRow = .Cells(.Rows.Count, "O").End(xlUp).Row 

    For r = 3 To endRow 
     If .Cells(r, "O").Value = 1 Then 
      pasteRowIndex = 1 
     Else 
      If .Cells(r, "O").Value = 5 Then 
       pasteRowIndex = 5 
      End If 
     End If 

     ' find last row with data in Column "O" in "Blad1" sheet 
     PasteRow = Sheets("Blad1").Cells(Sheets("Blad1").Rows.Count, "O").End(xlUp).Row 

     ' copy number of rows from "Doorvoeren" sheet to "Blad1" sheet, paste them on the first empty row in "Blad1" sheet 
     .Range("O" & r).Resize(pasteRowIndex).EntireRow.Copy Destination:=Sheets("Blad1").Range("A" & PasteRow + 1) 
    Next r  
End With 

End Sub 

Answer 3

です。

'==================================================== 
Sub testIt() 
    Dim r As Long, endRow As Long, pasteRowIndex As Long 
    Dim DestR as Range 
    Dim Rloop as Range 
    dim RowsCounter as Integer 

    endRow = 500 
    pasteRowIndex = 5 
    RowsCounter = 0 

    For Each Rloop in Sheets("Doorvoeren").range("O3:O" & endRow) 
     if Rloop = 1 and RowsCounter=0 then RowsCounter = Rloop.Offset(0, 2) 
     If Rloop = 1 or RowsCounter > 0 Then 

       Set DestR = Sheets("Blad1").range("A" & pasteRowIndex) 
       Rloop.EntireRow.Copy DestR 
       pasteRowIndex = pasteRowIndex + 1 
       RowsCounter = RowsCounter - 1 
     End If 
    Next Rloop 
End Sub 

これは、より良い支援を期待:)