Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

65178 / 76734

←次へ　｜　前へ→


	【16131】間隔を空けての貼り付け

YN61 - 04/7/17(土) 8:28 -


	引用なし

	パスワード

項目１　　項目２　　項目３　　項目４
aaa　　　AAA　　　 100　　　10
　　　　 ABB　　　 200　　　20

bbb　　　BBB　　　 300　　　30　　　　　　　　　　　　　
　　　　 BAA　　　 400　　　40　　　　　　　　　　　　　　

ddd　　　DDD　　　 500　　　50　　　　　　　　　　　　　
　　　　 DCC　　　600　　　 60　　　　　　　　　　100　　　10
　　　　 DEE　　　700　　　 70　　　　　　　　　　200　　　20
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
hhh　　　FFF　　　 800　　　 80　　　　　　　　　 300　　　30
　　　　 GGG　　　 900　　　 90　　　　　　　　　 400　　　40
　　　　　　　　　　　　　
　　　　　　　　　　　　　　　　　　　　　　　　　　　500　　　50
　　　　　　　　　　　　　　　　　　　　　　　　　　　 600　　　60
　　　　　　　　　　　　　　　　　　　　　　　　　　　 700　　　70

　　　　　　　　　　　　　　　　　　　　　　　　　　　 800　　　80
　　　　　　　　　　　　　　　　　　　　　　　　　　　 900　　　90

（貼り付けました表が左右にふれているかも知れませんが
お許しください）

上部左の表のように２行や３行単位の表があります
この行幅(行数)は表が作成される度に異なります。２～４行範囲で変化します。
しかし、一つの表のブロック単位後には１行空けて作成されています。
この表の数字のみ拾って、右のような別表に貼り付ける方法を考えています。
しかし、ブロック単位の１行空けがどうしても出来ませんが
良い方法をご教授ください。
現在はブロック単位に貼付を３行下にしています。

コードを次のようにしています。

Sub 選択貼付()

Dim i As Integer
Dim 最終行 As Integer
最終行 = Range("A65536").End(xlUp).Row

　j = 6
For i = 最終行 To 3 Step -1

If Cells(i, 1) <> "" Then
　Cells(i, 1).Select
　　Selection.Offset(, 2).Select
　　Range(Selection, Selection.End(xlToRight)).Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy

　j = j + 3
　Cells(j, 7).Select

　　Selection.PasteSpecial Paste:=xlValues
　　Application.CutCopyMode = False

End If

Next

Range("A1").Select

End Sub

0 hits

▼

【16131】間隔を空けての貼り付け YN61 04/7/17(土) 8:28

≪