Loop through folder and Copy values and Formats of first sheet into summary sheet

R

Reiss

New Member
Joined
Jan 9, 2019
Messages
10
I have been working through VBA code that copies the first sheet in a workbook from a folder to another workbook("Master").

The code copies the data correctly but upon saving I get certain cells with errors (#Ref) this is due some of the copied cells having formula.

I would like the copied to data to retain the original formatting but to only have values.
Or alternatively the cells with the 2 errors are M11 and O11 which have an index match formula, if these 2 cells values could be pasted without formula the rest of the copied data will be fine.


I have tried to use PasteSpecial xlPasteValuesAndNumberFormats and .PasteSpecial xlPasteFormats but I am not sure how to amend the copy function.
Code: 
[COLOR=#242729][FONT=Arial][COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR][COLOR=#303336][FONT=inherit] MergeMultipleWorkbooks[/FONT][/COLOR][COLOR=#303336][FONT=inherit]()[/FONT][/COLOR][/FONT][/COLOR]
<code style="font-style: inherit; font-variant: inherit; font-weight: inherit; white-space: inherit; margin: 0px; padding: 0px; border: 0px; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit;">[COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Dim[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Path[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Filename [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As [/FONT][/COLOR][COLOR=#101094][FONT=inherit]String[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

    Path [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"C:\Users\User\Desktop\ProMacro\"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    Filename [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Dir[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]Path [/FONT][/COLOR][COLOR=#303336][FONT=inherit]&[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"*.xlsx"[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Do [/FONT][/COLOR][COLOR=#101094][FONT=inherit]While[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Filename [/FONT][/COLOR][COLOR=#303336][FONT=inherit]<>[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]""[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

        [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Workbooks[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Open[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]Filename[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Path [/FONT][/COLOR][COLOR=#303336][FONT=inherit]&[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Filename[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#101094][FONT=inherit]ReadOnly[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]True[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
            [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Worksheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1[/FONT][/COLOR][COLOR=#303336][FONT=inherit]).[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Copy After[/FONT][/COLOR][COLOR=#303336][FONT=inherit]:=[/FONT][/COLOR][COLOR=#303336][FONT=inherit]ThisWorkbook[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Sheets[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]1[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit] 

            [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Close [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]False[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        [/FONT][/COLOR][COLOR=#101094][FONT=inherit]End [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

        Filename [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Dir[/FONT][/COLOR][COLOR=#303336][FONT=inherit]()[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Loop[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

    MsgBox [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Files has been copied Successfull"[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"MergeMultipleExcelFiles"[/FONT][/COLOR]</code>[COLOR=#242729][FONT=Arial][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR][/FONT][/COLOR]

 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Try this:

Code: 
Sub MergeMultipleWorkbooks()    '
    Dim Path, Filename As String
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Path = "C:\Users\User\Desktop\ProMacro\"
    Filename = Dir(Path & "*.xlsx")
    '
    Do While Filename <> ""
        With Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
            .Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
            .Worksheets(1).Cells.Copy
            ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlValues
            .Close False
        End With
        Filename = Dir()
    Loop
    MsgBox "Files has been copied Successfull", , "MergeMultipleExcelFiles"
End Sub
 
Upvote 0
Hi Dante thank you for the reply, I tried the code but get an error 'Run time error-1004 Paste special method of Range class failed'.

The error belongs to
Code: 
[COLOR=#333333]ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlValues[/COLOR]
seems to be an issue with the paste values
 
Upvote 0
Try this


Code: 
Sub MergeMultipleWorkbooks()
    '
    Dim Path, Filename As String
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Path = "C:\Users\User\Desktop\ProMacro\"
    Path = "C:\trabajo\books\"
    Filename = Dir(Path & "*.xlsx")
    '
    Do While Filename <> ""
        With Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
            .Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
            ThisWorkbook.ActiveSheet.Cells.Copy
            ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlValues
            .Close False
        End With
        Filename = Dir()
    Loop
    MsgBox "Files has been copied Successfull", , "MergeMultipleExcelFiles"
End Sub
 
Upvote 0
So I am looking for something similar to what you have posted here. I need to take a specific worksheet from several different excel files and place each worksheet on its own sheet in a master file. The following code does all that but I need it to copy and paste the data as values. The worksheets have lots of sumif formulas on them and they won't work unless the master file is open. Any suggestions on how to edit the following code or how to modify the one provided above for my needs? Thanks in advance!


Code: 
Sub CombineSheets()
    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Variant

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    sPath = InputBox("Enter a full path to workbooks")
    ChDir sPath
    sFname = InputBox("Enter a filename pattern")
    sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
    wSht = InputBox("Enter a worksheet name to copy")
    Do Until sFname = ""
        Set wBk = Workbooks.Open(sFname)
        Windows(sFname).Activate
        Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
        wBk.Close False
        sFname = Dir()
    Loop
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
AmandaF15 said:
So I am looking for something similar to what you have posted here. I need to take a specific worksheet from several different excel files and place each worksheet on its own sheet in a master file. The following code does all that but I need it to copy and paste the data as values. The worksheets have lots of sumif formulas on them and they won't work unless the master file is open. Any suggestions on how to edit the following code or how to modify the one provided above for my needs? Thanks in advance!
Click to expand...


I'm not sure if I should answer in this thread or you should create a new thread, but I'll send you the answer.
Try and tell me

Code: 
Sub CombineSheets()
    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Variant


    Application.EnableEvents = False
    Application.ScreenUpdating = False
    sPath = InputBox("Enter a full path to workbooks")
    ChDir sPath
    sFname = InputBox("Enter a filename pattern")
    sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
    wSht = InputBox("Enter a worksheet name to copy")
    Do Until sFname = ""
        Set wBk = Workbooks.Open(sFname)
        Windows(sFname).Activate
        Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
        ThisWorkbook.ActiveSheet.Cells.Copy
        ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlValues
        wBk.Close False
        sFname = Dir()
    Loop
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Could you help with a small issue, when I ran the code initially it would copy the files and close the open workbooks without saving changes.
When I run the code now I get a prompt asking me if I would like to save changes to the file that the info has been copied from .
I would like to prevent this prompt as there may be more than 50 files being copied from the folder.

I haven't changed the code posted in your reply, I did try the below but without luck.
.Close savechanges:=False
Click to expand...
 
Upvote 0
I have added the following to the code which seems to have resolved my issue.

Code: 
.Saved = True
            .Close False
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
VBA to open all files in a folder, put the file's name in a cell and copy it to another opened workbook
Replies
5
Views
1K
feni1388
F
V
  • Question Question
Copy each sheet to new workbook, paste values and save to specific folder
Replies
7
Views
655
JerrExcel
JerrExcel
I
  • Question Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
404
irishjsk
I
N
  • Solved
Sort emails in Outlook 365 folder, and loop through them opening the oldest first
Replies
7
Views
2K
John_w
J
F
  • Question Question
Macro that copies and pastes from each file into formatted master sheet with merged cells
Replies
1
Views
941
OaklandJim
O

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,619
Latest member
Shiv1198

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top