I found a specific formula for collating data from closed worksheets and it works great with one exception, and I'm sure it's a quick fix but I'm new to VBA. I need to formula to paste values instead of pasting the formulas. I'm sure it's a change to one or two lines and I will put the formula below and bold where I think it needs to be changed. Thanks for your time and help; I've been browsing the forum for hours looking for the answer and can't seem to find the right thing! I'm using Excel 2007.
Thanks!
-Brent
Formula:
Option Explicit
Sub CollateReportFromFiles()
'Open all .XLS in specific folder and import data (2007 compatible)
Dim strFileName As String, strPath As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet
Dim NR As Long, LR As Long, i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set wbkNew = ThisWorkbook
strPath = "C:\Users\Brent\Desktop\MACRO Test\Files\" 'Your path, don't forget the final \
strFileName = Dir(strPath & "*.xls")
wbkNew.Activate
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
For Each ws In Worksheets
If ws.Name <> "Temp" Then ws.Delete
Next ws
'Setup
ActiveSheet.Name = "Report"
Range("B1") = "Column 1"
Range("C1") = "Column 2"
Range("B1:C1").Interior.ColorIndex = 6
NR = 2
Do While Len(strFileName) > 0
Set wbkOld = Workbooks.Open(strPath & strFileName)
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LR
If Not IsEmpty(Cells(i, "B")) And IsEmpty(Cells(i, "C")) Then
Rows(i).Copy wbkNew.Sheets("Report").Range("A" & NR)
NR = NR + 1
End If
Next i
strFileName = Dir
wbkOld.Close False
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Thanks!
-Brent
Formula:
Option Explicit
Sub CollateReportFromFiles()
'Open all .XLS in specific folder and import data (2007 compatible)
Dim strFileName As String, strPath As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet
Dim NR As Long, LR As Long, i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set wbkNew = ThisWorkbook
strPath = "C:\Users\Brent\Desktop\MACRO Test\Files\" 'Your path, don't forget the final \
strFileName = Dir(strPath & "*.xls")
wbkNew.Activate
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
For Each ws In Worksheets
If ws.Name <> "Temp" Then ws.Delete
Next ws
'Setup
ActiveSheet.Name = "Report"
Range("B1") = "Column 1"
Range("C1") = "Column 2"
Range("B1:C1").Interior.ColorIndex = 6
NR = 2
Do While Len(strFileName) > 0
Set wbkOld = Workbooks.Open(strPath & strFileName)
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LR
If Not IsEmpty(Cells(i, "B")) And IsEmpty(Cells(i, "C")) Then
Rows(i).Copy wbkNew.Sheets("Report").Range("A" & NR)
NR = NR + 1
End If
Next i
strFileName = Dir
wbkOld.Close False
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub