Savecopyas Excel VBA后不再合并合并的细胞

Question

i在一定范围内合并了单元。合并区域的数量因工作表而异，有些有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

这似乎应该很容易，但是我在这里或其他任何地方都找不到答案。

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