Hello Everyone,
I have some code here that I got help with a while back - I've looked through it and I'm not exactly sure of the best way to change it so that the macro pastes values instead of formulas.
In case it helps, a quick rundown of what this code does:
It goes through each Excel file in a folder, copies a certain portion of the file, then pastes it in order in the macro workbook. Again, my goal is for the macro to copy the portion of each file and paste it in to the macro workbook so all formulas are now just values.
Here is the code:
Dim oWbk As Workbook
Dim uRng As Range
Dim rToCopy As Range
Dim rNextCl As Range
Dim lCount As Long
Dim bHeaders As Boolean
Dim sFil As String
Dim sPath As String
Dim objFile As Object
Dim objFso As New FileSystemObject
With Application
.DisplayAlerts = False
.EnableEvents = False
sPath = Sheets("Info").Range("A7").Value
Set flsFolder = objFso.GetFolder(sPath & "\")
For Each objFile In flsFolder.Files
sFil = objFile.Name
If InStr(1, Right(sFil, Len(sFil) - InStr(1, sFil, ".")), "xl") > 0 Then
With ThisWorkbook.Sheets("Net Assets")
Set uRng = .UsedRange
If uRng.Cells.Count = 0 Then
bHeaders = False
Else
bHeaders = True
End If
Set oWbk = Workbooks.Open(objFile)
Set rToCopy = oWbk.ActiveSheet.UsedRange
If Not bHeaders Then
Set rNextCl = .Cells(1, 2)
bHeaders = True
Else
Set rNextCl = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
Set rToCopy = rToCopy.Offset(6, 0).Resize(rToCopy.Rows.Count - 1, rToCopy.Columns.Count)
End If
rToCopy.Copy rNextCl
rNextCl.Offset(0, -1).Value = oWbk.ActiveSheet.Range("A4").Value
.Cells(Rows.Count, 1).End(xlUp).AutoFill Destination:=.Range(.Cells(Rows.Count, 1).End(xlUp), .Cells(.Cells(Rows.Count, "C").End(xlUp).Row, 1)), Type:=xlFillCopy
oWbk.Close False
End With
End If
Next
exithandler:
.DisplayAlerts = True
.EnableEvents = True
End With
If you can find anything else in here that you think might speed it up or help, I'm always open for suggestions!
Thanks in advance!
Bookmarks