ExcelのVBAでコピーのやり方

質問

シート１のAL列の3行目以降の中から0以外の
値が入っているAJ列～AN列の行を全てコピーして、
シート２のＢ列～Ｆ列に貼り付けたいです。
シート２のＢ列～Ｆ列の7行目から下にコピーした値を入れていきたく、
値が入っていたらその次の行に貼り付けたいです。
例えば、7行目～15行目まで値が入っていたら、16行目から貼り付けるようにしたいです。↓のように書いてみたのですが、
コピーしている状態になるだけで、シート2の方へ貼り付けができない状態です。
また、オブジェクトが必要ですと表示が出ます。

どこをどうなおしたらいいでしょうか。
文章がわかりにくく申し訳ありません。
回答よろしくお願いいたします。

sub 値をコピー()

Dim rTargetRange As Range, ii As Long
Set rTargetRange = Nothing
For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row
If (Cells(ii, "AL").Value <> 0) Then
If (rTargetRange Is Nothing) Then
Set rTargetRange = Cells(ii, "AJ").Resize(, 5)
Else
Set rTargetRange = Application.Union(rTargetRange, Cells(ii, "AJ").Resize(, 5))
End If
End If
Next

With Worksheets("sheet2")
With .Cells(.Rows.CountLarge, "B").End(xlUp)
If (.Row = 1 And .Value = "") Then
rTargetRange.Copy .Offset(0)
Else
rTargetRange.Copy .Offset(1)
End If
End With
End With

End Sub

また、↓のような違ったコードも試しましたが、
うまくいきませんでした。
N=Sheet2.Cells(Rows.CountLarge, "AL").End(xlUp).Row+1
SHEET1.SELECT
For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row
If Cells(ii, "AL").Valu e <> 0 Then
RANGE("AJ" & ii & ":AN" & ii).COPY SHEET2.RANGE("B" & N)
N=N+1
END IF
NEXT

回答No.6

imogasi

#2です。私が主張した方法で、コードを作ってみました。
小数データ例でしかテストしてないが。
test02のようなことが、できることも肝です。
下記は簡単で初歩的と思わないか？
Sub test01()
Dim d As Variant
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
k = 7 'copy先シートの貼り付け行ポインター
lr = sh1.Range("AL100000").End(xlUp).Row
'MsgBox lr
'---
For i = 3 To lr
If sh1.Cells(i, "AL") <> 0 Then
'MsgBox i
d = Range(sh1.Cells(i, "AJ"), sh1.Cells(i, "AN"))
sh2.Range(sh2.Cells(k, "B"), sh2.Cells(k, "F")) = d
k = k + 1
End If
Next i
End Sub
＝＝＝＝＝
Sub test02()
Dim d As Variant
d = Range("A1:c3")
Range("a10:c10") = d
End Sub

回答No.5

HohoPapa

ＯＳとエクセルが標準の備えている機能で
エクセルのシート（の一部）をデータベースのテーブルに見立て処理していますので

>VBAでそのコードを実行したらいいのでしょうか。
>他にSQLで何か下準備しないといけないのでしょうか。
そのまま実行できます。

>>必ずAJ列の値が空欄ではないという条件が必要です。
>4行目以降は全て０が入っている状態ですので、問題ないと思います。
これは、

>>　　LastRow = .Cells(Rows.Count, 2).End(xlUp).Row　
このコードが、最下行から上方向に
『最初に見つかる空欄以外のセル』を探しているため、
転記先（Ｓｈｅｅｔ１）のB列に空欄が混じると
正しい結果にならない場合があるからです。

回答No.4

HohoPapa

条件を満たす行たちを抽出し他の領域に複写する場合、
いろいろな方法がありますが、
私だったら、（若干ハードルが上がりますが）SQLを使います。
サンプルのコードをポストしますので
よかったら参考にしてください。

なお、抽出するレコードたちは、
必ずAJ列の値が空欄ではないという条件が必要です。
この条件を満たさない場合はコメントしてください。
別案を提示します。

また、
抽出元のシート名が　Sheet1
抽出先のシート名が　Sheet2
のコードです。

Option Explicit

Sub sample()

　Dim SQL As String
　Dim cn As Object
　Dim rs As Object
　Dim LastRow As Long

　'SQL全文を組み立て
　SQL = "SELECT *" & vbCrLf
　SQL = SQL & "FROM [" & "Sheet1$AJ3:AN10000]" & vbCrLf
　SQL = SQL & "Where F3 <> 0" & vbCrLf

　'SQLを実行
　Set cn = CreateObject("ADODB.Connection")
　Set rs = CreateObject("ADODB.Recordset")
　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
　cn.Properties("Extended Properties") = "Excel 12.0;HDR=No;IMEX=1"
　cn.Open ThisWorkbook.Path & "\" & ThisWorkbook.Name
　rs.Open SQL, cn

　'結果セットを出力
　With ThisWorkbook.Sheets("Sheet2")
　　LastRow = .Cells(Rows.Count, 2).End(xlUp).Row　'出力先行番号算出
　　If ((LastRow <> 1) Or (.Cells(1, 2).Value <> "")) Then
　　　LastRow = LastRow + 1
　　End If
　　.Cells(LastRow, 2).CopyFromRecordset rs　'結果セットを出力
　End With

　'後処理
　rs.Close
　Set rs = Nothing
　cn.Close
　Set cn = Nothing

End Sub

補足

回答ありがとうございます。
VBAでSQLを使ったことがなく、
普段SQLを使うこともほぼないので、
よくわからない部分があるのですが
VBAでそのコードを実行したらいいのでしょうか。
他にSQLで何か下準備しないといけないのでしょうか。
また、4行目以降は全て０が入っている状態ですので、問題ないと思います。

回答No.3

kkkkkm

No1の追加です。

Sheet1のAL列の4行目以降にデータが無い場合同じエラーになりますから

With Worksheets("sheet2")

の前に

If (rTargetRange Is Nothing) Then
MsgBox "データがありません", vbInformation
Exit Sub
End If

を入れておいてもいいと思います。

回答No.2

imogasi

（１）コピー法
　　条件判定にFilterなどが使える場合（条件が比較的簡単な場合など）使えるかも。
　コピー先のセル範囲の指定などは１行で済むのがメリット。
（２）個別に条件判定ーー＞合致ーー＞コピー先セル範囲に、代入法
行的に判定は、繰り返し法を使うことになる。
があると思う。初心者は（２）がおすすめ。
ーー
（２）は、貼り付け先の行ポインター・変数（例えばk)を使う。
--
コピー元とコピー先のシートが別の場合(本件もこれ）は、私は
Set Sh1=worksheets("Sheet1")
Set Sh2=worksheets("Sheet2")
のようにモジュールの最初に定義し、セル・セル範囲の指定には必ず、これを被せて、
明確にしている。
質問は指定したり、しなかったりしてないか。
ーー
本件（２）でやるとして、上記の注意点を読んで見直したら。

回答No.1

kkkkkm

コードがSheet1以外のモジュールにあって、実行時にSheet1以外を表示した状態で実行しているのだと思います。
Sheet1に対するコードの部分で(後半のSheet2に対するコードの要領で)
With Sheets("Sheet1")
End With
を利用してください。