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

问题描述 投票:0回答:2

这个问题的重大解决已在这里解决:

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

在调整代码之后,我在大约15分钟内完成了所有工作。然而,我花了过去3个小时搜索stackoverflow和互联网的其余部分试图找出如何让它只粘贴VALUES而不是带来格式和公式。

我尝试过使用.PasteSpecial xlPasteValues,但是每次尝试这个时我都会收到一条错误,上面写着“编译错误:预期:语句结束”

我也试过使用.PasteSpecial(xlPasteValues),我得到一个错误,上面写着“运行时错误'1004':无法获取Range类的PasteSpecial属性”

我担心的是这些方法都不会起作用,因为甚至没有.Paste功能开始。

因此,当我尝试添加.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
excel vba excel-vba
2个回答
0
投票

用此替换您的复制/粘贴:

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和后来的ElseEnd 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的帮助!

© www.soinside.com 2019 - 2024. All rights reserved.