|
項目1 項目2 項目3 項目4
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
(貼り付けました表が左右にふれているかも知れませんが
お許しください)
上部左の表のように2行や3行単位の表があります
この行幅(行数)は表が作成される度に異なります。2〜4行範囲で変化します。
しかし、一つの表のブロック単位後には1行空けて作成されています。
この表の数字のみ拾って、右のような別表に貼り付ける方法を考えています。
しかし、ブロック単位の1行空けがどうしても出来ませんが
良い方法をご教授ください。
現在はブロック単位に貼付を3行下にしています。
コードを次のようにしています。
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
|
|