Extracting data from multiple workbooks to one worksheet

Question

I am trying to copy data from multiple workbooks in a folder to one spreadsheet. This code works except that I cannot seem to be able to adjust it to paste just the values. Could someone please tell me how to edit the lines under "'Copy data on "SearchCaseResults" sheet to "Disputes" Sheet in other workbook" so it pastes values instead of the formulas, borders, etc. Thanks in advance!

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

So were you have trouble implementing [this approach](https://stackoverflow.com/questions/23937262/excel-vba-copy-paste-values-only-xlpastevalues)? Or were you trying to use [value transfer](https://stackoverflow.com/questions/51528000/vba-paste-as-values-how-to)? — BigBen, May 06 '20 at 20:39

score 1 · Accepted Answer · answered May 06 '20 at 20:42

You can do it with copy and pastespecial - you have to do it on two lines.

Btw your current code will overwrite the last used cell so I have added an 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

More efficiently, you can transfer values directly (though you have to specify the size of the destination range too).

    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

Should really be `xlPasteValues` even though that won't change any functionality, right? Though i've closed this as a dupe anyway. — BigBen, May 06 '20 at 20:44

Extracting data from multiple workbooks to one worksheet

1 Answers1