Combining Multiple Workbooks Into One - Paste Special - Values

[ibanez737]

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!

[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]

 

[JLGWhiz]

Change this:

Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)

To this

Range("A1:A" & LR).EntireRow.Copy 
.Range("A" & NR).PasteSpecial xlPasteValues

BTW there are several range references in the posted code which are not qualified with a sheet reference. Note in the snippet above that one has a period in front of the word "Range" and the other does not. The one without the period will revert to the active sheet, which may be OK for your purposes, but it is good practice to always qualify your sheets and ranges when working with more than one parent object.

 

[ibanez737]

Change this:

Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)

To this

Range("A1:A" & LR).EntireRow.Copy 
.Range("A" & NR).PasteSpecial xlPasteValues

BTW there are several range references in the posted code which are not qualified with a sheet reference. Note in the snippet above that one has a period in front of the word "Range" and the other does not. The one without the period will revert to the active sheet, which may be OK for your purposes, but it is good practice to always qualify your sheets and ranges when working with more than one parent object.

That worked perfectly, thank you! I also hadn't run the code yet and ran into the issue you mentioned. One of the users didn't save in the appropriate tab and it added the wrong data. I went in and added the proper sheet reference.

Would you happen to know a good way of accomplishing the check if the sheet is blank below the header?

 

[JLGWhiz]

Would you happen to know a good way of accomplishing the check if the sheet is blank below the header?

Not sure what you are asking here.
To check a single row where header is row 1.

If Application.CountA(ActiveSheet.Rows(2)) = 0 Then
 MsgBox "Row is Blank"
Else
 MsgBox "Row has data"
End If

To check the rest of the sheet with header in any single row.

If ActiveSheet.UsedRange.Rows.Count = 1 Then
 MsgBox "Rest of sheet is empty"
Else
 MsgBox "There is other data on sheet"
End If

There are probably other ways, but these two are pretty simple to understand.

Regards, JLG

 

[JuiceAnderson]

Hi everyone,

Hopefully I'm in the right place. I'm in need of a macro that can combine multiple tabs into one master sheet. Each tab has the same format and when it goes into the master tab it carry over the same format. I have been having difficulty doing this. Can anyone help me.

Juice