时间戳

首页 > 解决方案 > 将多个工作簿中的数据提取到一个工作表中

excel - 将多个工作簿中的数据提取到一个工作表中

问题描述

我正在尝试将文件夹中的多个工作簿中的数据复制到一个电子表格中。此代码有效，只是我似乎无法调整它以仅粘贴值。有人可以告诉我如何编辑“将“SearchCaseResults”表上的数据复制到其他工作簿中的“Disputes”表”下的行，以便粘贴值而不是公式、边框等。提前致谢！

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lRow As Long
Dim ws2 As Worksheet
Dim y As Workbook

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
    .Title = "C:\Users\Ashton\Desktop\Control\"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

Set y = Workbooks.Open("C:\Users\Ashton\Desktop\Control")
Set ws2 = y.Sheets("Sheet1")

'Loop through each Excel file in folder
Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Copy data on "SearchCaseResults" sheet to "Disputes" Sheet in other workbook
    With wb.Sheets("Timesheet")
        .Range("A9:B18").Copy ws2.Range("A" & Rows.Count).End(xlUp)
        .Range("B4").Copy ws2.Range("C" & Rows.Count).End(xlUp)
        .Range("S9:S18").Copy ws2.Range("D" & Rows.Count).End(xlUp)
    End With

    wb.Close SaveChanges:=True
    'Get next file name
    myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

标签： excelvba

解决方案

您可以使用 copy 和 pastespecial 来完成 - 您必须分两行完成。

顺便说一句，您当前的代码将覆盖最后使用的单元格，因此我添加了一个offset(1).

With wb.Sheets("Timesheet")
    .Range("A9:B18").Copy
    ws2.Range("A" & Rows.Count).End(xlUp).offset(1).pastespecial xlvalues
    .Range("B4").Copy
    ws2.Range("C" & Rows.Count).End(xlUp).offset(1).pastespecial xlvalues
    .Range("S9:S18").Copy
    ws2.Range("D" & Rows.Count).End(xlUp).offset(1).pastespecial xlvalues
End With

更有效的是，您可以直接传输值（尽管您也必须指定目标范围的大小）。

    With wb.Sheets("Timesheet")
        with .Range("A9:B18")
              ws2.Range("A" & Rows.Count).End(xlUp).offset(1).resize(.rows.count,.columns.count).value=.value
        End with
       'etc
    End With

推荐阅读