表を結合させたい　VBA（EXCEL2013）

###前提・実現したいこと
VBA超初心者です。

実現したいこと：別シート（日別）で同一箇所にある「日別」の表をループで結合させたい。

プログラミングに分かりやすく説明付けて頂けると助かります。
よろしくお願いいたします。

###発生している問題・エラーメッセージ

① ループさせたい。
② ないシート（日）もある。
③ 月によってある日（シート）が違う。

###該当のソースコード
Sub Macro6()
'
' Macro6 Macro
'

'
Sheets("01").Select
Range("S3:U30").Select
Selection.Copy
Sheets("集計表").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("02").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計表").Select
Range("A29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("03").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計表").Select
Range("A57").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("06").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計表").Select
Range("A85").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("07").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計表").Select
Range("A113").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("08").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計表").Select
Range("A141").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("09").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=3
Sheets("集計表").Select
Range("A169").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("10").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計表").Select
Range("A197").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveWindow.SmallScroll Down:=6

Sheets("11").Select
Range("S3:U30").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("集計表").Select
Range("A225").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

End Sub

###試したこと
上記で、現在あるデータは結合できた。

###補足情報(言語/FW/ツール等のバージョンなど)
VBA（EXCEL2013）

PineMatsu

2016/06/13 09:34 編集

ソースコードは```　```で囲って記述してください。そうすると見やすくなります。

marikon

2016/06/14 01:51

ご指摘ありがとうございます。勉強しまていきます。

行動規範の内容に同意します

回答1件

ベストアンサー

まずシートの存在確認をして、あればコピー＆ペースト、なければ次の日付、という流れで実現できると思います。

以下の改修案ですが、ずばり回答になってしまっているかもしれません。
そのまま動くとしても丸写しだけでは身に付きませんので、コードを自分なりに解析し、理解していただければ幸いです。

'シートの存在チェック
Function SheetExist(vSheetName) As Boolean

    Dim ws As Worksheet
    
    'すべてのシートをループ処理
    For Each ws In Worksheets
        If ws.Name = vSheetName Then
            'シート名が見つかったらTrueで終了
            SheetExist = True
            Exit Function
        End If
    Next ws
    
    'シート名が見つからなければFalseで終了
    SheetExist = False
    
End Function


Sub Macro6()
    Dim strShtNm As String      'シート名
    Dim lngPasteRow As Long     '貼り付け位置
    
    lngPasteRow = 1
    
    For i = 1 To 31
        strShtNm = Format(i, "00")
        'シートの存在チェック
        If SheetExist(strShtNm) = True Then
            'シートが見つかった場合、コピー＆ペースト
            Range(strShtNm & "!S3:U30").Copy
            '集計表シートに貼り付け
            Sheets("集計表").Cells(lngPasteRow, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                                                       SkipBlanks:=False, Transpose:=False
            '次の貼り付け位置
            lngPasteRow = lngPasteRow + 28
        End If
    Next
End Sub

改修のポイントは
・すべてのシートをループ処理
・シート変更・選択範囲の変更をせずにコピペ
・コピペ後に次の貼り付け位置を準備
です。

がんばってください。

投稿2016/06/13 09:01