VBAでフォルダ内の全てのｃｓｖファイルからコピペ

質問

マクロ超初心者です。

フォルダ内のすべてのｃｖｓファイル（５００程度）の5列目（500行程度）を新規ファイルの1列目から順にコピーしていきたいのです。

ちなみに元のｃｖｓファイルのシート数は一つだけでシート名には全てファイル名が付いています。
（つまり全てのファイルのシート名が異なる）

見よう見真似で似たようなマクロから意味もわからないまま
つぎはぎして下記作りましたが
やっぱり動きません。

どなたか詳しい方どうかよろしくお願いします。

Sub Sample()
Const FolderPath As String = "C:\data"
Dim objFSO As Object
Dim objBook As Object
Dim lngRow As Long

Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objBook In objFSO.GetFolder(FolderPath).Files
lngcolumn = ThisWorkbook.Sheets("sheet1").Range("A" & Columns.Count).End(xlToRight).Column + 1
Workbooks.Open objBook.Path
With ActiveWorkbook
.Worksheets(1).Column("5").Copy ThisWorkbook.Sheets("sheet1").End(xlToRight).Offset(0, 1)
.Close
End With
Next

Set objFSO = Nothing

Application.ScreenUpdating = True

End Sub

回答No.2

nattocurry · ベストアンサー

私なら、こんな感じで作ります。

Sub test()
Const FolderPath As String = "C:\data"
Dim Filename As String
Dim Sh0 As Worksheet, Sh As Worksheet
Dim c As Long

Set Sh0 = ActiveSheet
Filename = Dir(FolderPath & "\*.csv")
Do Until Filename = ""
c = c + 1
Set Sh = Workbooks.Open(FolderPath & "\" & Filename).Sheets(1)
Sh.Columns(5).Copy Sh0.Columns(c)
Application.DisplayAlerts = False
Sh.Parent.Close
Application.DisplayAlerts = True
Filename = Dir()
Loop
End Sub

お礼

完璧に動作しました。どうもありがとうございます。
半日がかりの仕事がトイレに行ってる間に済んでしまい、猛烈に感動しています。

ただ、当方のスキルがなさ過ぎ、内容を理解したとまでは到底言えませんので
時間をかけてじっくり解読してみたいと思います。

半ば心折れ掛けておりましたが、マクロ習得のモチベーションも
一気にＭＡＸに上がりました。

重ね重ねありがとうございました。

ちなみに今さらですが
下から7行目くらいののコードで「実行時エラー438、オブジェクトはこのプロパティまたはメソッドをサポートしていません」と出てました。どうも失礼しました。

回答No.1

nattocurry

どの命令で、どんなエラーが出たのか、くらいは書きましょうよ。