[[20110616162957]]　『複数のシートを１枚のシートにまとめるマクロを教』（りりあん）　ページの最後に飛ぶ

 『複数のシートを１枚のシートにまとめるマクロを教えてください。』（りりあん）
 Excel2002　WinXP

 住宅1ヶ月・6ヶ月・1年・集合1ヶ月・6ヶ月・1年という6枚の
 ワークシートがあります。
 ※書式はすべて同じです。

 リストの件数は作成することに件数が違います。
 これを『全データ』というシートにまとめるマクロを作りたいの
 ですが真ん中の“sh_check”というところでエラーが出てしまいます。

 下記のコードは
 http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_data_matome.html
 よねさんのWordとExcelの小部屋に乗っていたマクロを使用しています。

 デバックするところをどう訂正したらいいか教えてください。

  Dim newSh As String
  Dim Sh As Worksheet, myFlag As Boolean
    newSh = "全データ"
    myFlag = False
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name = newSh Then
            myFlag = True
            '----全データシートのデータをクリアし、先頭へ移動します
            Worksheets(newSh).Cells.ClearContents
            Worksheets(newSh).Move before:=Sheets(1)
            Exit For
        End If
    Next Sh
    '----全データシートを先頭へ追加します
    If myFlag = False Then
        ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh
    End If
  Dim i As Integer
  Dim lRow As Long, lCol As Long, lRow2 As Long
    Application.ScreenUpdating = False
     '----全データシートの有無をチェックします
    sh_check　⇒ここでデバックしてしまいます。
    '----列見出しをコピーします
    Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
    For i = 2 To Worksheets.Count
        With Worksheets(i)
            lRow = .Cells(Rows.Count, 1).End(xlUp).Row
            lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
            '----シートのデータが2行以上の場合にコピーします
            If lRow >= 2 Then
                lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Activate
                .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1)
            End If
        End With
    Next i
    Worksheets(1).Activate
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 sh_check というサブルーチンをコピペしないといけないんじゃないかな？
と思います。
(SoulMan）

 SoulManさん早速のご回答ありがとうございます。

 ところでサブルーチンって何ですか？

 とりあえず[[20110204143945]]　『シートをまとめるマクロ』（はな）さんの
 マクロをいじったら何とかなりそうです。

 17:02 りりあん

 [[20110204143945]]　『シートをまとめるマクロ』（はな）さんのマクロを使用したら
 リストは1枚のシートにまとまったのですが最後に"With Sheets(i)"の部分でエラーが
 表示しました。

 エラーの内容は『インデックスが有効範囲にありません』です。

 どう直したらよいか教えてください。

    Dim topSheet As Worksheet
    Set topSheet = ThisWorkbook.Sheets("全リスト")
    For i = 1 To 50
        ro = topSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
        With Sheets(i)　⇒ここでエラーが出ました。
           .Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).Copy Destination:=topSheet.Range("A" & ro)
        End With
    Next
 End Sub

 17:17 りりあん

 中身は全然みていませんけど、↓こんな　sh_check　という
コードが書いてないとそこに行けないというかぁ、、、、
メインがあって、サブがある、、わかります？
Sub sh_check()
　Dim newSh As String
　Dim Sh As Worksheet, myFlag As Boolean
　　newSh = "全データ"
　　myFlag = False
　　For Each Sh In ThisWorkbook.Worksheets
　　　　If Sh.Name = newSh Then
　　　　　　myFlag = True
　　　　　　'----全データシートのデータをクリアし、先頭へ移動します
　　　　　　Worksheets(newSh).Cells.ClearContents
　　　　　　Worksheets(newSh).Move before:=Sheets(1)
　　　　　　Exit For
　　　　End If
　　Next Sh
　　'----全データシートを先頭へ追加します
　　If myFlag = False Then
　　　　ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh
　　End If
End Sub
 >インデックスが有効範囲にありません
は、その名前のシートがないということです。
なんですが、インデックスなのでシートが50枚ないのかな？
(SoulMan）

 SoulManさんありがとうございました。

 For i = 1 To 50とはシート枚数の事だったんですね？
 勉強になりました。(*'-'*)/

 サブルーチンなんとなくわかりました。

 17:37 りりあん

 シート数が不確定なら、
 Dim Myc as integer
 Myc=ThisWorkbook.Worksheets.Count
 For i = 1 to Myc

 とすれば良いかと。

 mama

コメント返信：

[ 一覧(最新更新順) ]

[[20110616162957]] 『複数のシートを１枚のシートにまとめるマクロを教』（りりあん） ページの最後に飛ぶ

[[20110616162957]]　『複数のシートを１枚のシートにまとめるマクロを教』（りりあん）　ページの最後に飛ぶ