Merged cells are no longer merged after SaveCopyAs Excel VBA

Question

I have merged cells across a certain range. The number of merged areas varies by worksheet, some have 2, some have 10. Once the new file is created and saved, all merged areas pull the text back into the first cell in the range. I am really trying to save an exact hard coded copy, with a different file name.

Here is the portion of code that is used to save values and then SaveCopyAs:

Sheets("Send").Visible = True
Sheets.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False

Dim thisWb As Workbook, d As Integer

Set thisWb = ActiveWorkbook
d = InStrRev(thisWb.FullName, ".")
'ActiveWorkbook.SaveAs Filename:=Left(thisWb.FullName, d - 1) & "-Prelims" & Mid(thisWb.FullName, d)
Sheets("Send").Visible = False
Dim newFileName As String
newFileName = Left(thisWb.FullName, d - 1) & "-Prelims" & Mid(thisWb.FullName, d)
thisWb.SaveCopyAs Filename:=newFileName

This seems like it should be easy but I haven't been able to find the answer here on SO or anywhere else.

F8 through the code until you find the point in which the merged cells become unmerged. Then tell us. Also, please view this really good resource on not using Select stackoverflow.com/questions/10714251/… — Badja
I did not even know about the F8 tool, thanks! Looks like the issue occurs between ActiveSheet.Paste and Application.CutCopyMode = False — Michael Gallagher
I'm assuming you are copy/pasting like this because you don't want the formula's in the new sheet? — Badja
Yes, the file references databases that some people do not have access to, so i share a hard coded version so there are no formulas. Removing the ActiveSheet.Paste from the code seems to solve my issue. Thanks @Badja — Michael Gallagher

Badja Badja · Accepted Answer · 2019-03-19T16:40:24

Here is what your code should look like. This should be far more efficient for you

Let me know if anything is wrong:

Sub test()

Dim thisWb As Workbook, ws As Worksheet, d As Integer, lastRow As Long

Set ws = Sheets("Send")

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row      'Finds the bottom populated row

    With ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1)) 'This find the bottom of column A
        .Value = .Value                                 'Change to text rather than formula
    End With

Set thisWb = ActiveWorkbook
d = InStrRev(thisWb.FullName, ".")

    Sheets("Send").Visible = False

Dim newFileName As String

    newFileName = Left(thisWb.FullName, d - 1) & "-Prelims" & Mid(thisWb.FullName, d)
    thisWb.SaveCopyAs Filename:=newFileName

End Sub

Merged cells are no longer merged after SaveCopyAs Excel VBA

1 Answers