[[20180605154506]]　『複数のファイルを1つのファイルにした際のファイメx（かりん５８）　ページの最後に飛ぶ

『複数のファイルを1つのファイルにした際のファイルの取り込み順』（かりん５８）

こんにちわ。よろしくお願いします。

よくある件名の件、実行したく以下サイトからファイルをダウンロードしました。
http://excel-macro.com/book_sum/

シート名は変更しなくていいのでその箇所は削除しました。
そして結果以下内容となっていますが、ファイルを取り込む順番が取り込みたい順番とみごと逆になってしまいます。(シートの順番は希望通り)

ファイル名
01-xxxx
02-xxxx
03-xxxx
04-xxxx
05-xxxx
06-xxxx
・・・20ファイル程度

このファイル名の順番に、シートの順番もそのまま、新しいファイルの左側シートから順に一つのファイルにに集約したいです。
同じファイル名がある時は、ファイル名(1)、ファイル名(2)・・・で問題ないです。(それは今の状態でもなってくれます)

どこを直すとファイル名の昇順通りとりこまれますでしょうか。
調べてもシート名を変更するパターンしか見つけられず、教えてください<(_ _)>

Option Explicit

Sub book_sum()

    Dim sFile As String
    Dim sWB As Workbook, dWB As Workbook
    Dim dSheetCount As Long
    Dim i As Long
    Dim dl_Dir As String
    Dim SOURCE_DIR As String
    Dim DEST_FILE As String

    Application.ScreenUpdating = False '更新非表示
    Cells(2, 4).ClearContents

    'ダイアログでフォルダ選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "保存フォルダを選択して下さい"
        If .Show = False Then Exit Sub
        dl_Dir = .SelectedItems(1)
    End With

    SOURCE_DIR = dl_Dir & "\"
    DEST_FILE = SOURCE_DIR & "AllReports.xlsx"

    '指定したフォルダ内にあるブックのファイル取得
    sFile = Dir(SOURCE_DIR & "*.xls*")

    'フォルダ内にブックがなければ終了
    If sFile = "" Then Exit Sub

    '集約用ブックを作成
    Set dWB = Workbooks.Add
    ActiveSheet.Name = "st_book_sum"

    '集約用ブック作成時のシート数を取得
    dSheetCount = dWB.Worksheets.Count

    Do
        'AllReports.xlsxのチェック
        If sFile <> "AllReports.xlsx" Then
            Set sWB = Workbooks.Open(FileName:=SOURCE_DIR & sFile, ReadOnly:=True)

            For i = 1 To Sheets.Count
                Sheets(i).Visible = True
                'シートを集約用ブックにコピー
                sWB.Worksheets(i).Copy After:=dWB.Worksheets(dSheetCount)
            Next i

            'コピー元ファイルを閉じる
            sWB.Close SaveChanges:=False
        End If

        '次のブックのファイル名を取得
        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 SaveChanges:=False

    ThisWorkbook.Sheets(1).Cells(2, 4) = dl_Dir

    MsgBox "完了しました" & vbCrLf & "作業フォルダにファイルが作成されました"

    Application.ScreenUpdating = True '更新表示

End Sub

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

　＞'シートを集約用ブックにコピー

  ＞sWB.Worksheets(i).Copy After:=dWB.Worksheets(dSheetCount)

　　sWB.Worksheets(i).Copy After:=dWB.Worksheets(dwb.worksheets.count)

かなぁ。。。。

シートを左から数えたときの数でシートは指定できますから、
あとはその前に入れるのか後に入れるのかを考えてみてください。

After:=dWB.Worksheets(dSheetCount)
これだと、最初に3枚あったら、いつも3枚目のうしろに挿入という命令になる。

After:=dWB.Worksheets(dwb.worksheets.count)
これだと毎度毎度シート数を数えて、シート数番目のシート（＝一番右のシート）の後に挿入という
意味になります。

（まっつわん） 2018/06/05(火) 16:18

 一つの方法ですが　＾＾
ファイル名が決まっているなら。。。読込みたい順に配列かセルに並べて置き
その順番に読み込むと確実かもです。
不特定多数ファイルなら。。。
一旦ファイル名を取得後。ソートするとか。。。
違っていましたら済みません。
（隠居じーさん） 2018/06/05(火) 16:47

私も隠居じーさんさんの方法に１票です。

(1)対象ファイルの取得と並び替え
(2)ブックを開く～処理～ブック閉じる
のように分けて考えて（プロシージャを別にして）

(1)→(2)という順番で処理するように

 sub 実行用
 　call　マクロ1
 　call　マクロ2
 end sub

みたいにすれば希望の動作になるような気がします。

個人的には配列に格納された状態でソートする方法がわからないので、作業用のシートを1番目のシートとして挿入して、そのシートに対象ファイル一覧表の作成、並び替えをしたあと、(2)の作業がおわったら作業用シートをまるごと削除しちゃえばいろいろ見えないしいいんじゃないかな～なんて思います。

ExcelVBAでファイル一覧を作成する方法なんて、ネット検索すれば図解付きで沢山転がってるでしょうし・・・
（もこな２） 2018/06/06(水) 11:05

コメント返信：

[ 一覧(最新更新順) ]

[[20180605154506]] 『複数のファイルを1つのファイルにした際のファイメx（かりん５８） ページの最後に飛ぶ

[[20180605154506]]　『複数のファイルを1つのファイルにした際のファイメx（かりん５８）　ページの最後に飛ぶ