Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

32419 / 76807

←次へ　｜　前へ→


	【49626】Re:フォルダ配下のファイルからデータを転記したいのですが・・・

ウッシ - 07/6/13(水) 23:14 -


	引用なし

	パスワード

こんばんは

管理.xlsにマクロをセットするとして、
管理.xlsと同じフォルダ内に「北高校」フォルダがあるとして、
「北高校」フォルダ以下には各都道府県フォルダ内にしかExcelファイルが無いとして、
管理.xlsには各都道府県フォルダと完全に同じ名前のシートがあるとして、
その各都道府県名シートの1行目には
A　　　B
氏名　住所
のように項目名が入っているとして、

Sub test()
　　Dim sFile As String
　　Dim i　　 As Long
　　Dim fso　 As Object
　　Dim s　　 As String
　　
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　With Application.FileSearch
　　　　.NewSearch
　　　　.LookIn = ThisWorkbook.Path & "\北高校"
　　　　.SearchSubFolders = True
　　　　.FileName = "*.xls"
　　　　.MatchTextExactly = True
　　　　If .Execute() > 0 Then
　　　　　　For i = 1 To .FoundFiles.Count
　　　　　　　　sFile = fso.GetParentFolderName(.FoundFiles(i))
　　　　　　　　sFile = "='" & sFile & "\[" & Dir(.FoundFiles(i)) & _
　　　　　　　　　　　　"]情報'!"
　　　　　　　　s = fso.GetFile(.FoundFiles(i)).ParentFolder.Name
　　　　　　　　With Worksheets(s).Cells(65536, 1).End(xlUp)
　　　　　　　　　　.Offset(1).Formula = sFile & "R1C1"
　　　　　　　　　　.Offset(1).Value = .Offset(1).Value
　　　　　　　　　　.Offset(1, 1).Formula = sFile & "R1C2"
　　　　　　　　　　.Offset(1, 1).Value = .Offset(1, 1).Value
　　　　　　　　End With
　　　　　　Next
　　　　End If
　　End With
　　Set fso = Nothing
End Sub

1 hits

▼

【49625】フォルダ配下のファイルからデータを転記したいのですが・・・ momo 07/6/13(水) 21:26