Question

此问题的繁重工作已在这里解决：

Copy and paste data from multiple workbooks to a worksheet in another Workbook

修改代码后，我在大约15分钟内使一切正常运行。但是，随后我花了3个小时来检查stackoverflow，其余的Internet试图弄清楚如何仅粘贴VALUES而不是使用格式和公式。

我尝试使用 .PasteSpecial xlPasteValues ，但是每次尝试时，都会出现错误，提示“ 编译错误：预期：语句结束”

我也尝试过使用 .PasteSpecial（xlPasteValues），我收到一条错误消息，指出“ 运行时错误'1004'：无法获取Range类的PasteSpecial属性”

我担心的是，这些方法都不起作用，因为甚至没有.Paste函数。

因此，当我尝试仅添加。粘贴时，它给了我一个“ 运行时错误'438'：对象不支持此属性或方法”

这是整个代码，但是我主要是想弄清楚如何仅粘贴VALUES才能做到完全相同。谢谢！

Sub ConsolidateAllOrdenes()

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 = "Choose Target Folder Path"
.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 = "*.xlsm*"

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

Set y = Workbooks.Open("C:\Consolidado\Consolidado_2018-09-05a.xlsm")
Set ws2 = y.Sheets("Consolidado_Orden")

'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 "Orden de Compras" sheet to "consolidado_orden" Sheet in other     workbook
With wb.Sheets("Orden de Compras")
    lRow = .Range("C" & Rows.Count).End(xlUp).Row
    .Range("A5:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

End With

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

'Message Box when tasks are completed
MsgBox "I hope that worked!"

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

End Sub

Answer 1

使用以下内容替换您的副本/粘贴：

With wb.Sheets("Orden de Compras")
    Range("A2:M" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
    ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With

Answer 2

对不起，我对此并不陌生，但我想我终于明白了。我相信副本的范围缺少定义的工作簿和工作表。

一旦为副本指定了工作簿和工作表，将粘贴范围放在另一行并添加.PasteSpecial Paste:=xlPasteValues就没有问题。

我还从每个工作簿中复制了实际上没有任何内容的两行，因此我添加了If WorksheetFunction.CountA(wb.Sheets("Orden de Compras").Range("C5:C200")) <> 0 Then，后来又添加了Else和End If来跳过该工作簿（如果没有） C5：C200范围内的任何东西。

我还添加了Application.CutCopyMode = False，因为每个文件之后都会弹出一个消息框。

用以下内容替换复制/粘贴：

With wb.Sheets("Orden de Compras")
    If WorksheetFunction.CountA(wb.Sheets("Orden de Compras").Range("C5:C200")) <> 0 Then
    lRow = .Range("C" & Rows.Count).End(xlUp).Row
    wb.Sheets("Orden de Compras").Range("A5:M" & lRow).Copy
    ws2.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Else
    End If
End With

感谢所有人，尤其是@GMalc的帮助！！！

将多个工作簿中的值复制并粘贴到另一个工作簿中的工作表中/在循环中粘贴值

2 个答案: