記錄一個批次貼數的vba

Function CopyFilesToSheets()
	Dim fso As Object
	Dim folder As Object
	Dim file As Object
	Dim workbookPath As String
	Dim currentWorkbookName As String
	Dim targetWorkbook As Workbook
	Dim sourceWorkbook As Workbook
	Dim ws As Worksheet

	' 獲取當前工作簿路徑和名稱
	workbookPath = ThisWorkbook.Path
	currentWorkbookName = ThisWorkbook.Name

	' 建立FileSystemObject
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set folder = fso.GetFolder(workbookPath)

	' 設定目標工作簿為當前工作簿
	Set targetWorkbook = ThisWorkbook

	' 遍歷目標工作簿中的所有工作表
	For Each ws In targetWorkbook.Sheets
		messege = messege & ws.Name & "—————————" & vbNewLine
		' 遍歷資料夾中的檔案
		For Each file In folder.Files
			' 獲取檔名（不包括副檔名）
			Dim fileNameWithoutExtension As String
			fileNameWithoutExtension = Left(file.Name, InStrRev(file.Name, ".") - 1)
			
			' 如果檔名包含工作表名稱
			If InStr(1, fileNameWithoutExtension, ws.Name, vbTextCompare) > 0 And file.Name <> currentWorkbookName Then
				' 開啟源工作簿
				Set sourceWorkbook = Workbooks.Open(file.Path)
				' 清空目標Sheet內容
				ws.Cells.Clear
				' 複製源工作簿的第一個Sheet內容到目標Sheet
				sourceWorkbook.Sheets(1).Cells.Copy Destination:=ws.Cells
				' 關閉源工作簿
				sourceWorkbook.Close SaveChanges:=False
				' 退出檔案迴圈
				messege = messege & fileNameWithoutExtension & "—>" & ws.Name & vbNewLine
				Exit For
			End If
		Next file
	Next ws
	MsgBox messege
	' 清理物件
	Set file = Nothing
	Set folder = Nothing
	Set fso = Nothing
End Function