| |
▼INA さん：
>>A1.xls,A2.xls,A3.xls,A4.xls,B1.xls,というファイルがあり中身は表だったり
>>データだったりさまざまです。
>これらのブックのシート名はどうなっていますか？
INAさんお返事が遅くなり申し訳ありません。
ブックのシート名は規定のsheet１だったり1月だったりです。
下記は休み中に本を参考につくったものなんですが
(フォルダ名はファイル結合.xls上でダイアログから参照、結合先のファイルはa1.xls,a2.xls,a3.xls)
ダイアログからフォルダを参照させるとうまくいきません。
別でもいいので何か用意方法ございますでしょうか？
Private Sub CommandButton1_Click()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialView = msoFileDialogViewDetails
.AllowMultiSelect = False
.Show
.Execute ←デバックエラーがかかりダイアログからフォルダをひっぱることができません。
End With
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
Dim fpath As String
Dim fname As String
fpath = TextBox1
fname = TextBox2
newfil = TextBox3
MsgBox fpath & Chr(13) & _
"以下の、名前に「a」を含むExcelブックを名前順に表示します"
ActiveWorkbook.Worksheets.Add '---新規シートを追加
新規で作成するファイルを登録
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=fpath & newfil, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
With Application.FileSearch '---FileSearchオブジェクトに対して
.LookIn = fpath '---検索するフォルダを指定
.SearchSubFolders = True '---サブフォルダも検索対象にする
.Filename = "*" & fname & "*.xls" '---検索するファイル名の指定
.FileType = msoFileTypeExcelWorkbooks '---検索対象はエクセルブック
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then '---1.
MsgBox .FoundFiles.Count & " 個のExcelブックが見つかりました"
For i = 1 To .FoundFiles.Count
sanshou = .FoundFiles(i)
Workbooks.Open Filename:=sanshou, ReadOnly:=True
sanfname = ActiveWorkbook.Name
Set mysheet = ActiveWorkbook.Worksheets("sheet1")
mysheet.Copy before:=Workbooks(newfil).Worksheets(i)
Workbooks(newfil).Worksheets(i).Name = sanfname
Workbooks(sanfname).Close savechanges:=False
Next i
Else
MsgBox "該当するExcelブックはありません"
End If
End With
End Sub
Private Sub UserForm_Click()
End Sub
|
|
