Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


47657 / 76738 ←次へ | 前へ→

【34031】Re:複数ファイルのSheetの内容を新しいファイルの1つのSheetに結合したい
質問  初級++  - 06/1/25(水) 11:55 -

引用なし
パスワード
   大変申し訳ありませんが、もう一つ解決できない問題がでてきました。

Sub Combination_Start()

  Dim BaseFile    As String
  Dim vntFileName   As Variant
  Dim vntGetFileName As Variant
  Dim BaseWB     As Workbook   '元となるファイル
  Dim CopyWB     As Workbook  

  '元となる1.のファイルを1つだけを選択します
  BaseFile = Application.GetOpenFilename(filefilter:="Excel(*.xls),*.xls", Title:="1.のファイルを選択")
  If BaseFile = "False" Then
    Exit Sub
  End If
  
  '1.以外のファイルを開くダイアログを開きます
  vntFileName = Application.GetOpenFilename( _
       filefilter:="Excel(*.xls),*.xls" _
      , FilterIndex:=1 _
      , Title:="結合するファイルを1.以外すべて選択" _
      , MultiSelect:=True _
      )
  
  'BaseWBに1.ファイルを格納
  Set BaseWB = Workbooks.Open(Filename:=BaseFile, ReadOnly:=True)

  '2.以降のファイルを開き、1.BaseWBに追加していきます
  If IsArray(vntFileName) Then
    For Each vntGetFileName In vntFileName

      Workbooks.Open vntGetFileName
      Set CopyWB = ActiveWorkbook
      CopyWB.Worksheets(1).UsedRange.Copy _
      BaseWB.Worksheets(1).Range("A" & Sheet1.Rows.Count).End(xlUp).Offset(1)
            
    Next
  End If

  '全て結合したファイルの名前を:Test1.xlsとして保存します。
  BaseWB.SaveAs Filename:="Test1.xls"
  
  For Each WB In Workbooks
    If ThisWorkbook.Name <> WB.Name Then
      WB.Close False
    End If
  Next WB
  
  Set CopyWB = Nothing
  Set BaseWB = Nothing
  Set WB = Nothing
  
  Application.ScreenUpdating = True

End Sub

これが今回作成したマクロです。ただ2.以降のファイルを1.のファイルにコピーして追加することはできたのですが、追加する順番が想定したとおりになりません。
具体的には4つのファイルを結合する場合、1.2.3.4.となってほしいのですが、1.4.2.3.の順番になってしまいます。

どなたか解決法をご教授ください。お願いします。
0 hits

【33978】複数ファイルのSheetの内容を新しいファイルの1つのSheetに結合したい 初級++ 06/1/24(火) 15:28 質問
【33982】Re:複数ファイルのSheetの内容を新しいファ... inoue 06/1/24(火) 15:54 発言
【33986】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/24(火) 16:29 発言
【33994】Re:複数ファイルのSheetの内容を新しいファ... inoue 06/1/24(火) 18:47 発言
【34005】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/24(火) 21:10 お礼
【34031】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/25(水) 11:55 質問
【34037】Re:複数ファイルのSheetの内容を新しいファ... inoue 06/1/25(水) 14:10 発言
【34058】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/25(水) 17:52 お礼

47657 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free