修改复制脚本以保留格式

Question

我有一个复制脚本，它工作得很好，只是在运行时丢失了格式。我丢失了水平和垂直居中的文本、单元格背景色（用于条件）、所有边框和任何文本效果（粗体/下划线/斜体）。为了添加统一的边界，我使用

Range("CSResults").Borders.LineStyle = xlContinuous

虽然这是可行的，但并非所有边框的厚度都相同，单元格背景颜色也会根据单元格的内容而变化。

我需要修改我当前的脚本以保持格式。

复制脚本

Dim SectionCS As Long, NextRow As Long, TotalRows As Long
 Sheets("CS Results").Activate
 Range("CSResults").Select
 Selection.AutoFilter
 Range("CSResults").Clear
 For SectionCS = 1 To 13 '36
    NextRow = Sheets("CS Results").Range("A" & Rows.Count).End(xlUp).Row + 1 'Next empty row
    Sheets("Function Test Procedure - CS").Activate
    TotalRows = Range("CSSec" & SectionCS).Rows.Count
    Sheets("CS Results").Range("A" & NextRow).Resize(TotalRows, 14).Value = _
        Range("CSSec" & SectionCS).Columns("A:N").Value
 Next SectionCS

Answer 1

从技术上讲，您不是在复制/粘贴，而是在设置相等的值。要粘贴数据和格式，请使用pasteSpecial:

Range("CSSec" & SectionCS).Columns("A:N").Copy
With Sheets("CS Results").Range("A" & NextRow).Resize(TotalRows, 14)
     .PasteSpecial xlPasteFormats
     .PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False

这应该有效，只需仔细检查复制范围是否准确即可。