如何使用宏循环遍历文件夹并将数据从一个Excel工作簿复制到另一个工作簿并另存为新名称？

Sub LoopThroughFiles()
    Dim SourceFolder As String, DestinationFolder As String
    Dim FileName As String, NewFileName As String
    Dim SourceWorkbook As Workbook, DestinationWorkbook As Workbook
    Dim SourceWorksheet As Worksheet, DestinationWorksheet As Worksheet
    
    ' 设置源文件夹和目标文件夹路径
    SourceFolder = "源文件夹路径"
    DestinationFolder = "目标文件夹路径"
    
    ' 获取源文件夹中的所有文件
    FileName = Dir(SourceFolder & "\*.xlsx")
    
    ' 循环遍历源文件夹中的每个Excel文件
    Do While FileName <> ""
        ' 打开源工作簿
        Set SourceWorkbook = Workbooks.Open(SourceFolder & "\" & FileName)
        
        ' 获取源工作簿的第一个工作表
        Set SourceWorksheet = SourceWorkbook.Worksheets(1)
        
        ' 创建新文件名
        NewFileName = "新文件名" & Format(Now, "yyyymmddhhmmss") & ".xlsx"
        
        ' 复制源工作表到目标工作簿
        SourceWorksheet.Copy
        
        ' 设置目标工作簿
        Set DestinationWorkbook = ActiveWorkbook
        Set DestinationWorksheet = DestinationWorkbook.Worksheets(1)
        
        ' 另存为新文件名
        DestinationWorkbook.SaveAs DestinationFolder & "\" & NewFileName
        
        ' 关闭工作簿，不保存更改
        DestinationWorkbook.Close False
        
        ' 关闭源工作簿
        SourceWorkbook.Close
        
        ' 获取下一个文件名
        FileName = Dir
    Loop
    
    ' 提示完成
    MsgBox "操作完成！"
End Sub