首页 文章

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

提问于
浏览 次
0

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

将多个工作簿中的数据复制并粘贴到另一个工作簿中的工作表中

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

我尝试使用**.PasteSpecial xlPasteValues**，但是每次尝试此操作时，都会收到错误消息，提示“ 编译错误：预期：语句结尾”

我也尝试使用**.PasteSpecial(xlPasteValues)**，但收到错误消息“Run-time 错误'1004'：无法获取 Range 类的 PasteSpecial 属性”

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

因此，当我尝试仅添加**.Paste**时，它给了我一个“ Run-time 错误'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
excel vba excel-vba

2 回答

  • 0

    将您的 copy/paste 替换为：

    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
    回复于
  • 0

    抱歉，我是新手，但我想我终于明白了。我相信副本的范围缺少定义的工作簿和工作表。

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

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

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

    将 copy/paste 替换为：

    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

    感谢大家和 especially_1_for 的帮助！！！

    回复于

相关问题