以下のYahooブリーフケースからファイル
ConvineSheets.zip
をダウンロードし、中のEXCELファイルを開いてください。
簡単な使い方はファイルの中に書いてあります。
マクロの場所:
http://briefcase.yahoo.co.jp/bc/micnak2001/lst?&.dir=/3e2e&.src=bc&.view=l
http://sky.geocities.jp/robbie21st/
(2010-01-17 リンク変更)
#ニーズや要望があればエラー処理とかもうちょっとちゃんとしようかと思うのでコメントください。
#データが壊れたり、変なことしないように、ウィルスとかないように心がけていますが、使用の際には各自気をつけてくださいね。
ちなみに、列名とか関係なくシートをしてつないでいくマクロも
などで手に入ります。
-
- 以下マクロの説明
http://q.hatena.ne.jp/1155902791
EXCELで複数のシートを1つのシートにまとめる方法がありましたら教えてください。
いちいちコピーして貼り付けるのが面倒です。
に関連してマクロを作ってみた。
今回の質問者の意図に沿うかはわからないが、こういうニーズはいろんな質問サイトでしばしば目にするので誰かの役に立つこともあろう。
「マクロの入ったファイルなんて怖い」という人は以下にコードの中心部分を載せますのでご自由に使用・改変・配布してください。
Dictionaryオブジェクトを使用しているため、VBEで "Microsoft Scripting Runtime"に参照設定しておく必要があります。
Dim ConvinedSheet As Worksheet '開いているブックからシートを結合する ' '1行目のタイトルが同じ列のデータは '同じ列に結合する。 'sample 以下のマクロの使用方法サンプル Sub sample() Init AddSheetData ThisWorkbook.Sheets("Sample1") AddSheetData ThisWorkbook.Sheets("Sample2") End Sub '初期化 Public Sub Init() Set ConvinedSheet = Workbooks.Add.Worksheets(1) End Sub 'シートの追加 Sub AddSheetData(Sh As Worksheet) Dim DataStartRow As Range Set DataStartRow = LastUsedDataRow(ConvinedSheet).Offset(1, 0) Dim DataRange As Range Sh.Calculate Set DataRange = Range(Sh.Cells(1, 1), Sh.Cells.SpecialCells(xlCellTypeLastCell)) Dim Col As Range For Each Col In DataRange.Columns Col.Copy Dim PasteTarget As Range Set PasteTarget = DataStartRow.Cells(1, ColumnNumber(Col.Cells(1).Value)) PasteTarget.PasteSpecial xlPasteValuesAndNumberFormats Next DataStartRow.EntireRow.Delete Shift:=xlShiftUp End Sub 'シートの中で、最後に使われたデータ保管のための行を返す '1行目は列名が入るので除く Private Function LastUsedDataRow(Sh As Worksheet) As Range Dim UsedRow As Range Set UsedRow = Sh.Cells.SpecialCells(xlCellTypeLastCell).EntireRow While WorksheetFunction.CountA(UsedRow) = 0 And UsedRow.Row > 1 Set UsedRow = UsedRow.Offset(-1, 0) Wend Set LastUsedDataRow = UsedRow End Function '列名から、データを貼り付けるべき列番号を返す Private Function ColumnNumber(FieldName As String) As Long Dim c As Range For Each c In ConvinedSheet.Rows(1).Cells If CStr(c.Value) = FieldName Then ColumnNumber = c.Column Exit For ElseIf CStr(c.Value) = "" Then c.Value = FieldName ColumnNumber = c.Column Exit For End If Next End Function