0

I'm trying to make a merge file script just as this question. https://stackoverflow.com/a/4148797/1864883

It's working fine, it's copping the files into new worksheets inside the same new workbook.

The only problem is that the colours are not been the same in the target file.

Here is a screenshot comparing input and output:

enter image description here

Here is the macro that I'm running to accomplish the task:

    Option Explicit
'Ref: https://stackoverflow.com/a/26474331/1864883
Private Sub MergeFiles()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String, currentFile As Workbook, thisFile As Workbook, output As Workbook, outputName As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set thisFile = ActiveWorkbook   'Reference for current workbook

directory = thisFile.Sheets("teste1").Cells(2, 2).Value     'Get path of files to merge from cell B2
outputName = thisFile.Sheets("teste1").Cells(3, 2).Value    'Get output file name from cell B3
fileName = Dir(directory & "*.xl??")



Set output = Workbooks.Add  'Create new workbook for output

'Ref: https://stackoverflow.com/a/4148797/1864883
Do While fileName <> ""
    Set currentFile = Workbooks.Open(directory & fileName)  'Open file as current file
    WrdArray() = Split(fileName, ".")                       'Split file name in `.` to get name without extension
    For Each sheet In currentFile.Worksheets                'Interate each sheet
        currentFile.ActiveSheet.Name = WrdArray(0)          'Changes sheet name to same as file name
        sheetsInOutput = output.Worksheets.Count            'Amount of seets in output
        currentFile.Worksheets(sheet.Name).Copy after:=output.Worksheets(sheetsInOutput)

        GoTo exitFor:

        Next sheet

exitFor:
    currentFile.Close
    fileName = Dir()
Loop

output.Worksheets(1).Delete                                 'Delete first sheet crated when output created
output.SaveAs fileName:=thisFile.Path & "\" & outputName    'Saves output in same directory as this file
output.Close                                                'closes output file
'thisFile.Close

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
'Referência: https://stackoverflow.com/a/2051420/1864883
Private Sub Workbook_Open()
    Call MergeFiles        ' Call your macro
    'ActiveWorkbook.Save    ' Save the current workbook, bypassing the prompt
    'Application.Quit       ' Quit Excel
End Sub

PS: I tested with some other files that worked just fine, These file that I'm getting trouble are from Crystal Report.

Community
  • 1
  • 1
wviana
  • 1,619
  • 2
  • 19
  • 47

1 Answers1

2

Read this: https://msdn.microsoft.com/en-us/library/office/ff821660.aspx

You need make sure that both workbooks have same color.

Example:

ThisWorkbook.Colors = Workbooks(2).Colors
cyboashu
  • 10,196
  • 2
  • 27
  • 46
  • 1
    Worked fine. I added `output.Colors = currentFile.Colors` in first line of `exitFor:`. I know it's repeating for every file, but getting the same color scheme as the file works for me. – wviana Jul 18 '16 at 18:02