| |
大変申し訳ありませんが、もう一つ解決できない問題がでてきました。
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.の順番になってしまいます。
どなたか解決法をご教授ください。お願いします。
|
|
初級++
- 06/1/25(水) 11:55 -
