コピー行

Question

コード以下（コードの一つ）は、現在選択された列は、A列

で、単一の基準を貼り付けコピー&しかし、私が追加しようとしていますされている場合、正常に動作しています列Nから列Rが空白の場合、Excelはセルをコピーしません。私はコード2（以下）を作成しようとしましたが、実行時エラー '9'の下付き文字が範囲外です。

コード2を変更する際に助けを求めて、列を正しくフィルタリングすることができますか？

コード一つ

Dim i As Long 
Dim iLastRow As Long 
Dim iTarget As Long 

With Worksheets("Okay") 

    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
    For i = 1 To iLastRow 
     If .Cells(i, "A").Value = "Welcome" Then 
      iTarget = iTarget + 1 
      .Cells(i, "B").Copy 
      Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "C").Copy 
      Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "D").Copy 
      Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "E").Copy 
      Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "F").Copy 
      Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues 
      Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "How" 
      Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "Are" 
      Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "You" 
      Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "Okay" 
      .Cells(i, "N").Copy 
      Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "O").Copy 
      Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "P").Copy 
      Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "Q").Copy 
      Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "R").Copy 
      Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues 
     End If 
    Next i 

End With 

コード二

Dim i As Long 
Dim iLastRow As Long 
Dim iTarget As Long 

With Worksheets("Okay") 

    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
    For i = 1 To iLastRow 
     If .Cells(i, "A").Value = "Welcome" Then 
     If .Cells(i, "N").Value <> "" Then 
     If .Cells(i, "O").Value <> "" Then 
     If .Cells(i, "P").Value <> "" Then 
     If .Cells(i, "Q").Value <> "" Then 
     If .Cells(i, "R").Value <> "" Then 
      iTarget = iTarget + 1 
      .Cells(i, "B").Copy 
      Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "C").Copy 
      Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "D").Copy 
      Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "E").Copy 
      Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "F").Copy 
      Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues 
      Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "Hello" 
      Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "How" 
      Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "Are" 
      Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "You" 
      .Cells(i, "N").Copy 
      Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "O").Copy 
      Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "P").Copy 
      Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "Q").Copy 
      Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "R").Copy 
      Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues 
      .Cells(i, "G").Copy 
      Worksheets("Sheet7").Range("P" & iTarget + 1).PasteSpecial xlPasteValues 
     End If 
     End If 
     End If 
     End If 
     End If 
     End If 
    Next i 

End With 

Answer 1

あなたがライン上で

Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues 

を "添字範囲外" エラーを取得している場合は、最も可能性が高い理由（または、私が思うに、唯一の理由は）あなたが "Sheet7"と呼ばれるワークシートを持っていないということです。

---

注：コードを改善するには、コピー/ペーストを使用しないでください。コピー/貼り付けが遅く、マクロを実行するのを待っている間に他のアプリケーションで別の手動コピー/貼り付けを実行すると、問題が発生する可能性があります。

Dim i As Long 
Dim iLastRow As Long 
Dim iTarget As Long 
iTarget = 1 ' initialise value to avoid lots of "+ 1"s 

With Worksheets("Okay")  
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
    For i = 1 To iLastRow 
     If .Cells(i, "A").Value = "Welcome" Then 
     If .Cells(i, "N").Value <> "" Then 
     If .Cells(i, "O").Value <> "" Then 
     If .Cells(i, "P").Value <> "" Then 
     If .Cells(i, "Q").Value <> "" Then 
     If .Cells(i, "R").Value <> "" Then 
      iTarget = iTarget + 1 
      'Set 4 columns at once 
      Worksheets("Sheet7").Range("A" & iTarget).Resize(1, 4).Value = .Cells(i, "B").Resize(1, 4).Value 
      Worksheets("Sheet7").Range("F" & iTarget).Value = .Cells(i, "F").Value 
      Worksheets("Sheet7").Range("G" & iTarget).Value = "Hello" 
      Worksheets("Sheet7").Range("H" & iTarget).Value = "How" 
      Worksheets("Sheet7").Range("I" & iTarget).Value = "Are" 
      Worksheets("Sheet7").Range("J" & iTarget).Value = "You" 
      'Set 5 columns at once 
      Worksheets("Sheet7").Range("K" & iTarget).Resize(1, 5).Value = .Cells(i, "N").Resize(1, 5).Value 
      Worksheets("Sheet7").Range("P" & iTarget).Value = .Cells(i, "G").Value 
     End If 
     End If 
     End If 
     End If 
     End If 
     End If 
    Next i  
End With