CODEWITHSUNDEEP
vbaexcel
Soloban1
Soloban1

Reputation: 1

Copy and Paste VALUES from multiple workbooks to a worksheet in another workbook / Paste Value within Loop

The heavy lifting of this problem has already been solved here:

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

After adapting the code, I got everything to work perfectly in about 15 minutes. However, I then spent the past 3 hours scouring stackoverflow and the rest of the internet trying to figure out how to get it to paste VALUES ONLY instead of bringing over the formatting and formulas with it.

I've tried using .PasteSpecial xlPasteValues, but every time I try this I get an error that says "Compile Error: Expected: end of statement"

I've also tried using .PasteSpecial(xlPasteValues), I get an error that says "Run-time error '1004': Unable to get the PasteSpecial property of the Range class"

My concern is that neither of these methods will work since there wasn't even a .Paste function to begin with.

So when I tried to just add .Paste, it gives me a "Run-time error '438': Object doesn't support this property or method"

Here's the whole code, but I'm mainly just trying to figure out how to do exactly the same with except pasting VALUES ONLY. Thanks!

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

Upvotes: 0

Views: 1977

Answers (2)

Soloban1
Soloban1

Reputation: 1

Sorry, I'm new to this, but I think I finally figured it out. I believe the range with the copy was lacking a defined workbook and sheet.

Once I specified the workbook and sheet for the copy, there was no issue with putting the paste range on another line and adding .PasteSpecial Paste:=xlPasteValues.

I was also copying 2 lines from each workbook that didn't actually have anything, so I added If WorksheetFunction.CountA(wb.Sheets("Orden de Compras").Range("C5:C200")) <> 0 Then and later Else and End If to skip that workbook if it didn't have anything within the range C5:C200.

I also added Application.CutCopyMode = False because a message box kept popping up after each file.

Replace the copy/paste with this:

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

Thanks to everyone and especially @GMalc for the help!!!

Upvotes: 0

GMalc
GMalc

Reputation: 2628

Replace your copy/paste with this:

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

Upvotes: 1

Related Questions