VBA将另一个excel文件内容复制到当前工作簿

这就是我想要实现的目标：

我想将最新修改的excel文件中整个第一张工作表的内容复制到指定目录中。然后，我想将此复制操作的值粘贴到当前工作簿的第一页

---

我知道有宏可以获取目录中最后修改的文件，但我不确定一种快速、干净的方法来实现这一点。

午餐时，我没有更好的事情要做，所以开始吧

要启动它，请使用：

getSheetFromA（）

将其放入当前文件：

Dim most_recent_file(1, 2) As Variant
Sub getSheetFromA()

    ' STEP 1 - Delete first sheet in this workbook
    ' STEP 2 - Look through the folder and get the most recently modified file path
    ' STEP 3 - Copy the first sheet from that file to the start of this file


    ' STEP 1
    ' Delete the first sheet in the current file (named incase if deleting the wrong one..)
    delete_worksheet ("Sheet1")

    ' STEP 2
    ' Now look for the most recent file
    Dim folder As String
    folder = "C:\Documents and Settings\Chris\Desktop\foldername\"

    Call recurse_files(folder, "xls")

    ' STEP 3
    Dim most_recently_modified_sheet As String
    most_recently_modified_sheet = most_recent_file(1, 0)
    getSheet most_recently_modified_sheet, 1
End Sub

Sub getSheet(filename As String, sheetNr As Integer)
    ' Copy a sheet from an external sheet to this workbook and put it first in the workbook.
    Dim srcWorkbook As Workbook

    Set srcWorkbook = Application.Workbooks.Open(filename)
    srcWorkbook.Worksheets(sheetNr).Copy before:=ThisWorkbook.Sheets(1)

    srcWorkbook.Close
    Set srcWorkbook = Nothing
End Sub

Sub delete_worksheet(sheet_name)
    ' Delete a sheet (turn alerting off and on again to avoid prompts)
    Application.DisplayAlerts = False
    Sheets(sheet_name).Delete
    Application.DisplayAlerts = True
End Sub

Function recurse_files(working_directory, file_extension)
    With Application.FileSearch
        .LookIn = working_directory
        .SearchSubFolders = True
        .filename = "*." & file_extension
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles

        If .Execute() > 0 Then
            number_of_files = .FoundFiles.Count
            For i = 1 To .FoundFiles.Count
                vFile = .FoundFiles(i)

                Dim temp_filename As String
                temp_filename = vFile

                ' the next bit works by seeing if the current file is newer than the one in the array, if it is, then replace the current file in the array.
                If (most_recent_file(1, 1) <> "") Then
                    If (FileLastModified(temp_filename) > most_recent_file(1, 1)) Then
                        most_recent_file(1, 0) = temp_filename
                        most_recent_file(1, 1) = FileLastModified(temp_filename)
                    End If
                Else
                    most_recent_file(1, 0) = temp_filename
                    most_recent_file(1, 1) = FileLastModified(temp_filename)
                End If
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With
End Function

Function FileLastModified(strFullFileName As String)
    ' Taken from: http://www.ozgrid.com/forum/showthread.php?t=27740
    Dim fs As Object, f As Object, s As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFullFileName)


    s = f.DateLastModified
    FileLastModified = s

    Set fs = Nothing: Set f = Nothing

End Function

将最新的文件（1，2）变暗为变体
子getSheetFromA（）
'步骤1-删除此工作簿中的第一张工作表
'步骤2-查看文件夹并获取最近修改的文件路径
'步骤3-将第一张图纸从该文件复制到此文件的开头
"第一步,
'删除当前文件中的第一张工作表（如果删除了错误的工作表，则命名为incase.）
删除工作表（“表1”）
"第二步,
'现在查找最新的文件
将文件夹设置为字符串
folder=“C:\Documents and Settings\Chris\Desktop\foldername\”
调用递归文件（文件夹“xls”）
"第三步,
将最近修改的图纸变暗为字符串
最近修改的工作表=最近修改的文件（1，0）
getSheet最近修改的工作表，1
端接头
子getSheet（文件名为字符串，sheetNr为整数）
'将工作表从外部工作表复制到此工作簿，并将其放在工作簿的第一位。
将工作簿设置为工作簿
设置srcfoolk=Application.Workbooks.Open（文件名）
srcWorkbook.Worksheets（sheetNr）.Copy before:=此工作簿.Sheets（1）
关闭工作簿
设置srcpoolk=Nothing
端接头
子删除工作表（工作表名称）
'删除工作表（关闭并再次打开警报以避免提示）
Application.DisplayAlerts=False
工作表（工作表名称）。删除
Application.DisplayAlerts=True
端接头
函数递归文件（工作目录、文件扩展名）
使用Application.FileSearch
.LookIn=工作目录
.SearchSubFolders=True
.filename=“*”&文件扩展名
.MatchTextExactly=True
.FileType=msoFileTypeAllFiles
如果.Execute（）>0，则
文件数=.FoundFiles.Count
对于i=1到.FoundFiles.Count
vFile=.FoundFiles（i）
Dim temp_文件名为字符串
temp_filename=vFile
'下一位的工作原理是查看当前文件是否比数组中的文件新，如果是，则替换数组中的当前文件。
如果（最新的文件（1，1）”），则
如果（FileLastModified（temp_filename）>最近的文件（1，1）），那么
最近的文件（1，0）=临时文件名
最近的文件（1，1）=FileLastModified（临时文件名）
如果结束
其他的
最近的文件（1，0）=临时文件名
最近的文件（1，1）=FileLastModified（临时文件名）
如果结束
接下来我
其他的
MsgBox“未找到任何文件。”
如果结束
以
端函数
函数FileLastModified（strFullFileName为字符串）
“摘自：http://www.ozgrid.com/forum/showthread.php?t=27740
将fs设置为对象，将f设置为对象，将s设置为字符串
设置fs=CreateObject（“Scripting.FileSystemObject”）
Set f=fs.GetFile（strFullFileName）
s=f.DateLastModified
FileLastModified=s
Set fs=Nothing：Set f=Nothing
端函数

见下文。这将使用当前活动工作簿，并在

C:\Your\Path

中查找具有最新修改日期的Excel文件。然后，它将打开文件并复制第一张工作表中的内容，并将其粘贴到原始工作簿中（第一张工作表上）：

---

谢谢你的努力-我相信这会很好，但我已经接受了上面Philip的答案。事后我把它改成：

wkbData.Sheets（1）.Cells.Copy wkbSource.Sheets（1）.Range（“A1”）.Paste特殊粘贴：=xlValues，u操作：=xlNone，skipblank:=False，Transpose:=False

，因为我只需要值，不需要格式。这可以工作，但会产生一个“您在剪贴板上放置了大量数据”对话框。有什么办法抑制这种情况吗？补充道。应该编译并处理现在包含的更改吗

Dim fso, fol, fil
Dim wkbSource As Workbook, wkbData As Workbook

Dim fileData As Date
Dim fileName As String, strExtension As String

Set wkbSource = ActiveWorkbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder("C:\Your\Path")

fileData = DateSerial(1900, 1, 1)

    For Each fil In fol.Files

        strExtension = fso.GetExtensionName(fil.Path)
        If Left$(strExtension, 3) = "xls" Then

            If (fil.DateLastModified > fileData) Then
                fileData = fil.DateLastModified
                fileName = fil.Path
            End If

        End If

    Next fil

Set wkbData = Workbooks.Open(fileName, , True)

wkbData.Sheets(1).Cells.Copy 
wkbSource.Sheets(1).Range("A1").PasteSpecial Paste:=xlValues

Application.CutCopyMode = False

wkbData.Close

Set fso = Nothing
Set fol = Nothing
Set flc = Nothing
Set wkbData = Nothing