Excel VBA質問箱 IV

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

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


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

12454 / 76734

←次へ　｜　前へ→


	【69800】Re:別ブックのデータを縦にくっつける

UO3 - 11/8/30(火) 20:31 -


	引用なし

	パスワード

▼みちゃこさん：

ブックを開かないでリンク式をセットして対応する方法もありますが
ここは、素直に、開いて処理しましょう。

Sub Sample()
　　Dim myPath As String
　　Dim fName As String
　　Dim v As Variant
　　Dim i As Long
　　Dim sh As Worksheet
　　
　　Application.ScreenUpdating = False
　　
　　Set sh = ThisWorkbook.Sheets("OUTPUT")
　　i = 3
　　myPath = "C:\元データ"
　　
　　fName = Dir(myPath & "\*.xls")
　　Do While Len(fName) > 0
　　　　Workbooks.Open myPath & "\" & fName
　　　　v = Split(fName, ".")
　　　　sh.Cells(i, "A").Resize(21, 5).Value = Range("C5:G25").Value
　　　　sh.Cells(i, "F").Resize(21).Value = v(0)
　　　　ActiveWorkbook.Close savechanges:=False
　　　　i = i + 21
　　　　fName = Dir()
　　Loop
　　
　　Application.ScreenUpdating = True
　　MsgBox "集約が終わりました"
　　
End Sub

1 hits

▼

【69799】別ブックのデータを縦にくっつける みちゃこ 11/8/30(火) 18:55