Hello,
I've put together code to merge multiple files together. This works great in most cases, however I now have to merge data that contains formulas, but I only want to copy the values over.
When I run my code currently, I get all sorts of reference errors.
I "bolded" the section below where the copy occurs, but not sure how to work in the "values" only part.
Thanks in advance for any help that can be provided!
Mary-Lou
Dim ToBook As String
Dim ToSheet As Worksheet
Dim LogSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
Dim LogOutRow As Long
' MAIN ROUTINE
Sub Merge_Files_With_Headings()
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
' LOG tab
Set LogSheet = Sheets("Log")
Sheets("Log").Select
NumColumns = LogSheet.Range("A1").End(xlToRight).Column
ToRow = LogSheet.Range("A65536").End(xlUp).Row
' Clear LOG sheet
If ToRow <> 1 Then
LogSheet.Range(LogSheet.Cells(2, 1), _
LogSheet.Cells(ToRow, NumColumns)).ClearContents
LogSheet.Cells.ClearContents
End If
ToRow = 2
'Merge tab
Set ToSheet = Sheets("Merge")
Sheets("Merge").Select
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A65536").End(xlUp).Row
'clear data
If ToRow <> 1 Then
ToSheet.Range(ToSheet.Cells(2, 1), _
ToSheet.Cells(ToRow, NumColumns)).ClearContents
LogSheet.Cells.ClearContents
End If
ToRow = 2
' main loop to open each file in folder
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data_with_headings
End If
FromBook = Dir
Wend
MsgBox ("Done.")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'COPY DATA FROM ONLY WORKSHEETS LABELLED "RESPONSES" TO THE MASTER SHEET
Private Sub Transfer_data_with_headings()
Workbooks.Open Filename:=FromBook
For Each FromSheet In Workbooks(FromBook).Worksheets
If LCase(FromSheet.Name) Like "*responses*" Then
LastRow = FromSheet.Range("A65536").End(xlUp).Row
' copy into to master merge sheet
FromSheet.Range(FromSheet.Cells(3, 1), _
FromSheet.Cells(LastRow, NumColumns)).Copy _
Destination:=ToSheet.Range("A" & ToRow)
'write to log tab
LogOutRow = LogSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
LogSheet.Cells(LogOutRow, 1).Value = FromBook
LogSheet.Cells(LogOutRow, 2).Value = FromSheet.Name
LogSheet.Cells(LogOutRow, 3).Value = LastRow
'set next ToRow
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
End If
Next
Workbooks(FromBook).Close savechanges:=False
End Sub
Bookmarks