Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : Excel 2016)
フォルダを指定するには?
投稿日時: 20/02/13 13:46:16
投稿者: m024240

よろしくおねがいします。
 
モーグのVBA即効テクニック:複数ブックのシートを1つのブックにコピーする
のコードで、データの入ったフォルダをその都度指定するには、
どう変更するとよいのでしょうか?
ご教授ください。
 
Sub Sample()
    Dim sFile As String
    Dim sWB As Workbook, dWB As Workbook
    Dim dSheetCount As Long
    Dim i As Long
    Const SOURCE_DIR As String = "C:\Data\Source\"
    Const DEST_FILE As String = "C:\Data\AllReports.xls"
     
    Application.ScreenUpdating = False
     
    '指定したフォルダ内にあるブックのファイル名を取得
    sFile = Dir(SOURCE_DIR & "*.xls")
     
    'フォルダ内にブックがなければ終了
    If sFile = "" Then Exit Sub
     
    '集約用ブックを作成
    Set dWB = Workbooks.Add
     
    '集約用ブック作成時のシート数を取得
    dSheetCount = dWB.Worksheets.Count
     
    Do
        'コピー元のブックを開く
        Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)
         
        'コピー元の「報告書」シートを集約用ブックにコピー
        sWB.Worksheets("報告書").Copy After:=dWB.Worksheets(dSheetCount)
         
        'シート名をセルA1の値に変更
        ActiveSheet.Name = Range("A1").Value
                 
        'コピー元ファイルを閉じる
        sWB.Close
         
        '次のブックのファイル名を取得
        sFile = Dir()
    Loop While sFile <> ""
         
    '集約用ブック作成時にあったシートを削除
    Application.DisplayAlerts = False
    For i = dSheetCount To 1 Step -1
        dWB.Worksheets(i).Delete
    Next i
    Application.DisplayAlerts = True
       
    '集約用ブックを保存して閉じる
    dWB.SaveAs Filename:=DEST_FILE
    dWB.Close
     
    Application.ScreenUpdating = False
End Sub

回答
投稿日時: 20/02/13 15:45:34
投稿者: simple

下記の記事
http://officetanaka.net/excel/vba/tips/tips39.htm
を参考にしてください。

投稿日時: 20/02/14 00:11:34
投稿者: m024240

simple 様
 
参考ページありがとうございました。
参考ページの「1.FileDialogオブジェクトを使う方法」でやってみようと思います。
 
投稿してから、集計の仕方が変わり、「即効テクニック」のコードは利用できなくなりました。
改めてコードを作成するので、お助け頂けるとありがたいです。
 
ひとまず、解決済みにさせて頂きます。