| |
こんにちは。かみちゃん です。
>ブックの構成
>
>●1枚目：使わないシート
>●2枚目〜8枚目：縦に結合したいシート
> それぞれ同じフォーム「A5〜F15にデータあり」
> ただし、5行目はタイトル行
>
>したいこと
>●2枚目〜8枚目を縦に結合したい。
>●タイトル行は先頭のみ必要
>
>という前提で以下のコードを書きました。
>しかし、A列の左に１列追加して（罫線などの書式はA列と同じ）
>シート名を各行のA列として縦にくっつけたいという要望がありました。
>これに対応したいのですが、どう書いていいのか分かりません。
>
>
>●1列追加のところはチャレンジしたましたが、エラーが出ました。
>●シート名を各行のA列として縦にくっつける部分は全く分かりません。
以下のようなことがしたいのでしょうか？
Sub 結合()
Dim Worksheet As Worksheet
Dim DATA1 As Range, DATA2 As Range
Dim i As Integer
'入力ボックスにてシート名前、出力先、出力データセットを入力する。
'先頭にシートを作成する
' Sheets(3).Copy before:=Sheets(1)
Sheets.Add
ActiveSheet.Name = "縦結合"
' Sheets(1).Name = "縦結合"
'最初にデータセットを出力する位置を設定する
Set DATA1 = Worksheets("縦結合").Range("A6")
For i = 3 To Worksheets.Count
'結合したいデータセットをDATA2として読み込む。
Set DATA2 = Sheets(i).Range("A6:F15")
'DATA1をDATA2とする。
DATA2.Copy DATA1.Offset(, 1)
DATA1.Resize(DATA2.Rows.Count).Value = Sheets(i).Name '★
'次のデータセットを出力する位置を設定する。
Set DATA1 = DATA1.Offset(DATA2.Rows.Count)
Next
'A列をコピーして挿入する
' Sheets(1).Range("A").Copy
' Sheets(1).Range("B").Insert
' Application.CutCopyMode = False
'データセットをリセットする。
Set DATA1 = Nothing
Set DATA2 = Nothing
End Sub
>●1列追加のところはチャレンジしたましたが、エラーが出ました。
エラーが出る理由は、
Sheets(1).Range("A:A").Copy
Sheets(1).Range("B:B").Insert
としなければいけません。
>●シート名を各行のA列として縦にくっつける部分は全く分かりません。
上記の★の行のように処理すればできます。
|
|
かみちゃん
- 10/9/8(水) 21:52 -
