Объединенные ячейки больше не объединяются после SaveCopyAs Excel VBA

Question

Я объединил ячейки в определенном диапазоне.Количество объединенных областей варьируется в зависимости от листа, некоторые имеют 2, некоторые имеют 10. После того, как новый файл создан и сохранен, все объединенные области переносят текст обратно в первую ячейку диапазона.Я действительно пытаюсь сохранить точную жестко закодированную копию с другим именем файла.

Вот часть кода, которая используется для сохранения значений, а затем 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

ЭтоКажется, это должно быть легко, но я не смог найти ответ здесь, в SO или где-либо еще.

Answer 1

Вот как должен выглядеть ваш код.Это должно быть гораздо более эффективным для вас

Дайте мне знать, если что-то не так:

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