マクロメモ
Option Explicit
Sub CopyDataAndSaveNewWorkbook()
Dim SourceFolder As String
Dim SourceFile As String
Dim NewWorkbook As Workbook
Dim Pathtest As Object
Dim Filename As String
Dim wb As Workbook
Set Pathtest = ThisWorkbook.ActiveSheet.Cells(2, 1) ' 指定のフォルダのパスを設定
SourceFolder = Pathtest.Value ' フォルダのパスを変更
Filename = Dir(SourceFolder & "*.xlsx")
MsgBox "1" & SourceFolder
MsgBox "2" & Filename
Do While Filename <> ""
Dim WFna As String
WFna = Dir(SourceFolder & "*ABC.xlsx")
Workbooks.Open Filename:=SourceFolder & WFna
' ファイル名の末尾に「ABC」が含まれている場合にファイルを開く
' If Right(Filename, 4) = "ABC" Then
' Set wb = Workbooks.Open(SourceFolder & Filename)
' ここでファイルごとの処理を行うことができます
' 例: ファイルを開いた後、データの操作など
' ファイルを閉じる
' wb.Close SaveChanges:=False
' MsgBox "1" & SourceFolder
' MsgBox "2" & Filename
' Exit Do
' End If
Filename = Dir
MsgBox "4" & Filename
Loop
MsgBox "3" & Filename
' フォルダ内の最新のExcelファイルを検索
' SourceFile = Dir(SourceFolder & "*.xlsx")
' Do While SourceFile <> ""
' If FileDateTime(SourceFolder & SourceFile) > FileDateTime(SourceFolder & SourceFile) Then
' SourceFile = SourceFolder & SourceFile
' End If
' SourceFile = Dir
' Loop
MsgBox SourceFile
Dim Awb As Workbook
Set Awb = ActiveWorkbook
Set NewWorkbook = Workbooks.Add
' データをコピー
Awb.Worksheets(1).Range("A:J").Copy Awb.Worksheets(1).Range("A1")
' 最新のExcelファイルを開く
' Workbooks.Open SourceFile
Set Awb = ActiveWorkbook
Awb.Worksheets("Sheet1").Range("A1").PasteSpecial
' 新しいブックに名前を付けて保存
NewWorkbook.SaveAs "C:\Users\fafur\OneDrive\ドキュメント\excel練習\test\NewWorkbook.xlsx" ' 保存パスとファイル名を変更
NewWorkbook.Close
End Sub