Hi,
I've been looking through the forums and came upon a pretty populer consolidation macro. The main thing I need to change is for it to paste just the values into the master sheet, instead of just normal pasting. I can't seem to see where in the code this might be.
Also, the macro is copying all data but the header. Is there a way to include a check that sees if there is no data below the header, to not copy it over? The way the macro is written ends up copying over the header since it is the row about the first blank row. Any help is much appreciated!
I've been looking through the forums and came upon a pretty populer consolidation macro. The main thing I need to change is for it to paste just the values into the master sheet, instead of just normal pasting. I can't seem to see where in the code this might be.
Also, the macro is copying all data but the header. Is there a way to include a check that sees if there is no data below the header, to not copy it over? The way the macro is written ends up copying over the header since it is the row about the first blank row. Any help is much appreciated!
Code:
[FONT=courier new]Option Explicit
Sub Consolidate()
[B]'Author: Jerry Beaucaire'
'Date: 9/15/2009 (2007 compatible) (updated 4/29/2011)
'Summary: Merge files in a specific folder into one master sheet (stacked)
' Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
[B]'Setup
Application.ScreenUpdating = False [B]'speed up macro execution
Application.EnableEvents = False [B]'turn off other macros for now
Application.DisplayAlerts = False [B]'turn off system messages for now
Set wsMaster = ThisWorkbook.Sheets("[B]Master") [B]'sheet report is built into
With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.UsedRange.Offset(1).EntireRow.Clear
NR = 2
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 [B]'appends data to existing data
End If
[B]'Path and filename (edit this section to suit)
fPath = "[B]C:\2011\Files\" [B]'remember final \ in this string
fPathDone = fPath & "Imported\" [B]'remember final \ in this string
On Error Resume Next
MkDir fPathDone [B]'creates the completed folder if missing
On Error GoTo 0
fName = Dir(fPath & "[B]*.xls*") [B]'listing of desired files, edit filter as desired
[B]
'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then [B]'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) [B]'Open file
[B] 'This is the section to customize, replace with your own action code as needed
LR = Range("A" & Rows.Count).End(xlUp).Row [B]'Find last row
Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
wbData.Close False [B]'close file
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 [B]'Next row
Name fPath & fName As fPathDone & fName [B]'move file to IMPORTED folder
End If
[/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/FONT][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][FONT=courier new] fName = Dir [B]'ready next filename
[/B][/FONT][B][FONT=courier new] Loop
End With
ErrorExit: [B]'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True [B]'turn system alerts back on
Application.EnableEvents = True [B]'turn other macros back on
Application.ScreenUpdating = True [B]'refreshes the screen
End Sub
[/B][/B][/B][/B][/FONT][B][B][B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B]
[B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B]