[[20211124134035]] 『特定のシートを除いて処理する方法(VBA)』(ちゃろ) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『特定のシートを除いて処理する方法(VBA)』(ちゃろ)

シート名:グラフ
シート名:集計
シート名:Aさん
シート名:Bさん
シート名:Cさん

1つのExcelファイルの中に
上記のシートが存在しています。

やりたいこととしては
Aさん、Bさん、Cさんのデータを
集計シートに集約させたいのです。

グラフシートが無ければ問題なく処理ができたのですが
グラフシートを除いて処理することができません。
コードのほうはどのようにしたら良いか教えていただけますでしょうか


Sub 集計()
    Dim sWS As Worksheet  'データシート(コピー元)
    Dim dWS As Worksheet  '集約用シート(コピー先)

    Set dWS = Worksheets("AllData")

    '集約用シートの2行目以降を削除
    dWS.UsedRange.Offset(1, 0).Clear

    '各シートの2行目以降のデータを、集約用シートの末尾にコピー
    For Each sWS In Worksheets
        If sWS.Name <> dWS.Name Then
            With sWS.UsedRange

                'コピー元シートにデータが1件以上ある場合
                If .Rows.Count > 1 Then
                    .Offset(1, 0).Resize(.Rows.Count - 1).Copy _
                        Destination:=dWS.Cells(Rows.Count, 1). _
                                        End(xlUp).Offset(1, 0)
                End If

            End With
        End If
    Next sWS

    '集計用シートをA列で並べ替え
    dWS.UsedRange.Sort Key1:=Range("A1"), Header:=xlYes
End Sub

< 使用 Excel:Excel2010、使用 OS:Windows10 >


 If sWS.Name <> dWS.Name Then


 If sWS.Name <> dWS.Name And sWS.Name <> "グラフ" Then

シート名は実際のものに合わせてください。

(きまぐれおじさん) 2021/11/24(水) 13:51


きまぐれおじさん さん
ありがとうございます!思った通りの動作になりました。
(ちゃろ) 2021/11/24(水) 13:58

既に解決済みですが、Select Caseで分岐するという手もありますね。
除外したいシートが多いときに検討するとよいかもしれません。
    Sub 集計_改()
        Dim sWS As Worksheet  'データシート(コピー元)
        Dim dWS As Worksheet  '集約用シート(コピー先)
        Set dWS = Worksheets("AllData")

        '集約用シートの2行目以降を削除
        dWS.UsedRange.Offset(1, 0).Clear

        '各シートの2行目以降のデータを、集約用シートの末尾にコピー
        For Each sWS In Worksheets
            Select Case sWS.Name
                Case dWS.Name, "グラフ"
                    '何もしない(←記述しなくてもよい)

                Case Else
                    With sWS.UsedRange
                        'コピー元シートにデータが1件以上ある場合
                        If .Rows.Count > 1 Then
                            .Offset(1, 0).Resize(.Rows.Count - 1).Copy Destination:=dWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                        End If
                    End With
            End Select
        Next sWS

        '集計用シートをA列で並べ替え
        dWS.UsedRange.Sort Key1:=Range("A1"), Header:=xlYes
    End Sub

(もこな2) 2021/11/24(水) 14:21


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.