エクセルVBAについて質問です。


灰色(デフォルトの色)のシートの全ての内容を、「全部」という一つのシートにまとめ、
Q列にはまとめる前のシート名が記入されるというマクロを作成してください。

例えば、「sheet1」には10行目まで、
「sheet2」には20行目まで、何かが記入されているとします。
最後尾に「全部」というシートを作成して、
そのシートの1~10行目までが「sheet1」の内容となり、
Q1~Q10には「sheet1」と記入され、
11~30行目までは「sheet2」の内容となり、
Q11~Q30には「sheet2」と記入されるということです。

ただし、シートに色がついている場合は、この作業が行われません。
また、まとめる前のシート内に空白の行がある場合も、
空白のまま「全部」にコピーされるようにしてください。

なお、下記の点にご留意ください。
①それぞれのマクロがどう働くか「’」をもちいて説明してください。
②マクロは貼り付けてすぐに動くものをお願いします。
③質問が不明瞭でしたらコメントでご確認ください。

回答の条件
  • 1人2回まで
  • 登録:2008/01/04 15:34:12
  • 終了:2008/01/05 10:28:18

回答(1件)

id:airplant No.1

airplant回答回数220ベストアンサー獲得回数492008/01/05 09:58:35

ポイント180pt

次のマクロでどうでしょうか。

前類似のマクロを作ったことがありました。→前は、シート名を入れずに全部を集合させて、集合元のシートは削除してしまうものでした。

※集合シート名やシート名を入れる列の場所は、適宜変更ください。

'変数は必ず定義
Option Explicit

Sub シートを一つにまとめる()
' すべてのシートを「全部」シートにまとめる
    
    Const sTotalShtName As String = "全部"  '集合シート名
    Const sNameCol As String = "Q"          'シート名を入れる列
    Dim iSheetCNT As Integer    'sheetの個数
    Dim i As Integer
    Dim lCurRow As Long         '付け加えるsheetの行数
    Dim lTotalRow As Long       '集合シートの追加する行位置
    
    '全シート数を取り出し
    iSheetCNT = Sheets.Count
    '後ろへシートを追加して名前を変更
    Sheets.Add After:=Sheets(iSheetCNT)
    ActiveSheet.Name = sTotalShtName
    lTotalRow = 1

    For i = 1 To iSheetCNT
        'Copy元を選択してデータがある範囲をコピーする
        Worksheets(i).Select
        'シート見出しが色なしの場合だけ処理
        If ActiveSheet.Tab.ColorIndex = xlColorIndexNone Then
            Range("A1", ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address).Select
            Selection.Copy
            'コピーした行数を記憶しておく
            lCurRow = Selection.Areas(1).Cells.Rows.Count
            'Copy先へ貼り付け(A列の追加行位置へ)
            Sheets(sTotalShtName).Select
            Range("A" & CStr(lTotalRow)).Select
            ActiveSheet.Paste
            '指定列へシート名を入れる(今回貼り付けの範囲へ)
            Range(sNameCol & lTotalRow, sNameCol & (lTotalRow + lCurRow)) = Worksheets(i).Name
            '集合シートは次の行位置に進める
            lTotalRow = lTotalRow + lCurRow
        End If
    Next i
    Range("A1").Select

End Sub
id:taroemon

ご回答ありがとうございます。

望んでいた物ができました。

2008/01/05 10:27:20

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません