エクセルVBAコピー

エクセルマクロのVBAについてご教示ください、

データ一覧の表にフィルターをかけた後、データ項目行を除くセルをコピーして、別ブックにペーストするようにしたのですが、うまく貼り付きません。


For i = 1 To 100

' フィルタ
sheet1.Range("A1:CX1").AutoFilter field:=102, Criteria1:=CStr(i)

' フィルタ結果カウント
cnt = WorksheetFunction.Subtotal(3,
sheet1.Range("CX2").CurrentRegion.Columns(102))


If cnt > 1 Then

Set bookNew = Workbooks.Open(sPath & "\入力原票.xlsx")
Set sheetNew = bookNew.Sheets(1)

' コピー

sheet1.Range("A2:CW2000").Copy
sheetNew.Range("A9:CW2009").PasteSpecial Paste:=xlPasteValues

問題点があれば教えていただきたいです。

No.2 回答者： Qchan1962 回答日時： 2022/06/09 16:57

こんばんは、あくまで推測の範疇ですが

' コピー

Dim n As Long
n = Application.Max(9, sheetNew.Cells(Rows.Count, "A").End(xlUp).Row + 1)
Sheet1.Range("A2:CW2000").SpecialCells(xlCellTypeVisible).Copy
sheetNew.Range("A" & n).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

No.1 回答者： fujillin 回答日時： 2022/06/08 22:48

こんばんは

＞問題点があれば教えていただきたいです。
部分抜き出しなのでしょうけれど、切り取り方が微妙なのでハッキリとはしませんが、ご提示のコードからだけで言うならば・・

・変数sheet1、sPathの内容が不明。（ご提示の外で設定しているのかも）
　(sheet1はオブジェクト名でのダイレクト指定なのかも？）
・Forループに対するNextがないので、どこまでなのかが不明。
・もしも、ループ内だとするなら
　　＞Set bookNew ～～
　　＞Set sheetNew ～～
　同じ処理を何度も繰り返しているのは無駄。
　（ループ外で、事前処理として行っておくべき）
・同じく、ループ内なのなら
　　＞sheetNew.Range("A9:CW2009").PasteSpecial ~~
　同じセルへ何度も上書きすることになるので無意味。
　（この処理が正しいのなら、最後の1度だけ処理をすれば足りる）

想像するところ、↑の処理が『うまく貼り付きません。』というご質問の原因なのかと。
（「うまくいかない」という情報だけからでは、何もわかりませんけれど・・）


以下は、シートの状態にもよるので、何とも言えませんが・・
　＞sheet1.Range("A1:CX1").AutoFilter ～～
・タイトル行の指定だけで、目的範囲が正確に指定できているのか微妙。
　一方で、コピー範囲は2000行迄一律指定にしている・・

　＞cnt = WorksheetFunction.Subtotal ～～
・（はっきりとはしませんが）第二引数は、sheet1.Columns(102)だけでも足りそうだが・・

全体的に、シートやセル範囲の指定などの考え方（妙に丁寧だったり大雑把だったり）に統一性が感じられません。