Excel VBAについての質問です。 添付写真のようにA1からH24までの表があった場合に空白以外のセルのみを 抽出してコピー後にS1からZ12の表に値のみ (書式設定等は貼り付けない) 貼り付けるという事をしたいのですがこの場合はどういった記述をすれば いいのでしょうか?

画像

Excel | プログラミング135閲覧xmlns="http://www.w3.org/2000/svg">100

ベストアンサー

この回答はいかがでしたか? リアクションしてみよう

ThanksImg質問者からのお礼コメント

ありがとうございます。

お礼日時:10/13 6:16

その他の回答(4件)

なぜ1レコードに2行使っているんでしょうか… とりあえず Sub コピー() Dim from_data As Range Set from_data = [A1:E1] Dim Set As Range Set to_data = [S1:W1] For i=1 to 12 If Range.cells(1,1).value <> "" Then to_data = from_data.value Set to_data = to_data.offset(2,0) End If Set from_data = from_data.offset(2,0) Next End sub

空白の所に色が塗ってある、ということは空白のセルに数式が入っている可能性が高いです。なので単純な最終セルの取得ではうまくいかないです。 それとセルの結合は書式なので値貼り付けするとセルの結合が解除されてS1セルに貼り付けられます。添付図を見るとそれはうまくないですね。 「最後のセル」から上に「文字数」1以上のセルで最終行を取得します。 セル幅も取得します。 Sub test() Dim i As Long, lastrow As Long, rw As Long lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row For i = lastrow To 1 Step -1 If Len(Cells(i, 1)) > 0 Then rw = i Exit For End If Next Range("A1:H" & rw + 1).Copy Range("S1") Columns("S:Z").ColumnWidth = Columns("A:H").ColumnWidth Range("S1").CurrentRegion.Interior.Color = RGB(210, 210, 210) End Sub

こんな感じになるかと。 Sub Sample() With Range("A1", Cells(Rows.Count, "E").End(xlUp)) Range("S1").Resize(.Rows.Count, .Columns.Count).Value = .Value End With End Sub