Sub フォルダ内のファイル名やファイルパスを取得()
Dim intIchi As Integer
Dim strFolderpass As String
Dim objfFSO As Object
Dim objFiles As Object
Dim objFile As Object
'ファイル名一覧を出力する行番号を指定します。
intIchi = 3
'対象フォルダのファイルパスがあるセルを指定し、値を代入します。
strFolderpass = Range("B1").Value
'指定範囲の値をクリアします。
Range("A3:B10000").Clear
'対象フォルダのファイルパスの値があれば処理をおこないます。
If strFolderpass = "" Then
MsgBox "対象フォルダのファイルパスがありません。ファイルパスを入力してください。"
Else
'FileSystemObjectはファイルやフォルダを操作する専用のオブジェクトです｡インスタンスにセットします。
Set objfFSO = CreateObject("Scripting.FileSystemObject")
'対象フォルダのファイルオブジェクトをセットします。
Set objFiles = objfFSO.GetFolder(strFolderpass).Files
'ファイル情報を出力します。
For Each objFile In objFiles
Cells(intIchi, 1) = objFile.Name
Cells(intIchi, 2) = objFile.Path
intIchi = intIchi + 1
Next objFile
End If
Set objfFSO = Nothing
Set objFiles = Nothing
Set objFile = Nothing
End Sub
Sub 各ブックのシートのデータをまとめ用ブックへコピーする()
Dim objWorkbook As Workbook
Dim i As Integer
Dim strBookList As Variant
Dim intLastRowNum As Integer
Dim intLastRowNum2 As Integer
Dim intLastRowNum3 As Integer
Dim strCopyMotoListSheetName As String
Dim strCopyMotoSheetName As String
Dim strCopySakiSheetName As String
'コピー元ブック一覧があるシート名を指定します。
strCopyMotoListSheetName = "コピー元ブック一覧"
'コピー元ブックのシート名を指定します。
strCopyMotoSheetName = "Sheet1"
'コピー先のシート名を指定します。
strCopySakiSheetName = "別ブックデータ集約"
With ThisWorkbook
'B列を対象に最終行数を取得します。
intLastRowNum = .Sheets(strCopyMotoListSheetName).Cells(Rows.Count, 2).End(xlUp).Row
'コピー元ブック一覧があるシートの３行目からパスを取得します。
For i = 3 To intLastRowNum
'コピー元ブックパスを取得します。
strBookList = .Sheets(strCopyMotoListSheetName).Cells(i, 2).Value
'コピー元ブックを開きます。
Set objWorkbook = Workbooks.Open(strBookList)
With objWorkbook.Sheets(strCopyMotoSheetName)
'コピー元ブックのA列を対象に最終行数を取得します。
intLastRowNum2 = .Cells(Rows.Count, 1).End(xlUp).Row
'コピー元ブックのセル範囲をコピーします。コピーの範囲を変更する場合は設定を変えてください。
.Range("A2:C" & intLastRowNum2).Copy
End With
'コピー先のシートA列を対象に最終行数を取得し、1加算します。
intLastRowNum3 = .Sheets(strCopySakiSheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1
'コピー先のシートへ値のみ貼り付けします。貼り付け開始列はA列となります。
.Sheets(strCopySakiSheetName).Cells(intLastRowNum3, 1).PasteSpecial Paste:=xlPasteValues
Next i
End With
'範囲選択を解除します。
Application.CutCopyMode = False
'オブジェクトを解放します。
Set objWorkbook = Nothing
End Sub
迅速なご対応ありがとうございます。
感謝です！
今後も参考にさせていただきます。
とても便利だと思い参考にさせていただいております。
最後のオブジェクトを開放した後にコピー元のブックをすべて閉じるのを追加したいのですがうまく出来ません。
VBA初心者のため教えていただけると幸いです。よろしくお願いいたします。
いつもご利用ありがとうございます。
コピー元ブックをすべて閉じる方法につきましては、記事内に追記させていただきましたので、
よろしければご参考ください。
https://extan.jp/?p=10065#%EF%BC%9C%E8%BF%BD%E5%8A%A0%EF%BC%9E%E3%82%B3%E3%83%94%E3%83%BC%E5%85%83%E3%81%AE%E3%83%96%E3%83%83%E3%82%AF%E3%82%92%E3%82%B3%E3%83%94%E3%83%BC%E5%BE%8C%E3%81%AB%E9%96%89%E3%81%98%E3%82%8B%E6%96%B9%E6%B3%95
迅速なご対応ありがとうございました。
大変業務で参考になる記事を書いていただいており感謝申し上げます。
記事投稿大変かと思いますが、
これからも更新楽しみにしております。
記事内のVBAコードが別記事のものに間違えている気が致します。
ご指摘ありがとうございます。
またコードの内容が誤っていたことお詫び申し上げます。
先ほど修正をさせていただきました。
よろしくお願いいたします。