excel - 必须使用 VBA 在 Excel2010 中复制单元格格式

Question

我正在尝试编写代码以将单个长电子表格解析为多张工作表。我有解析代码工作，复制和粘贴也工作。但是粘贴只会以默认宽度创建单元格。我需要复制所有单元格格式。也就是说，单元格高度、宽度、背景颜色、前景色、边框等。该部分正在生成运行时 1004 错误。下面是我的代码:

Sub SplitData()

mycount = 0
myrow = 0

Do
   mycount = mycount + 1
   oldrow = myrow + 1
   Sheets("Master").Select

   Do
      myrow = myrow + 1
   Loop Until Left(Sheets("Master").Range("A" & myrow), 4) = "Run:"

   Sheets.Add
   ActiveSheet.Name = "Data" & mycount
   Sheets("Master").Select
   Rows(oldrow & ":" & myrow).Select
   Selection.Copy
   Sheets("Data" & mycount).Select
   Range("A1").Select
   ActiveSheet.Paste 
   ActiveSheet.PasteSpecial xlPasteFormats ' (THE ERROR OCCURS HERE)
Loop Until Left(Sheets("Master").Range("A" & myrow + 1), 3) = "xxx"

End Sub

我是一个非常有经验的 VBA 编码器，但对 Excel 语法完全是新手。有人可以帮我解决这个问题吗？ “xlPasteAll”属性也失败了，这是我首先使用单个 PastSpecial 方法尝试的。

任何想法将不胜感激!

谢谢

Answer 1

尝试这个

Selection.Copy
Sheets("Data" & mycount).Select
With Range("A1")
    .PasteSpecial xlValues
    .PasteSpecial xlPasteFormats
End With

跟进

This works physically, But for some reason, it is not actually copying the formatting (cell sizes etc). It's getting fonts and text colors okay, but not cell sizes or merged cells or visible borders.

这是你正在尝试的吗？

Sub SplitData()
    Dim ws As Worksheet

    mycount = 0
    myrow = 0

    Do
       mycount = mycount + 1
       oldrow = myrow + 1
       Sheets("Master").Select

       Do
          myrow = myrow + 1
       Loop Until Left(Sheets("Master").Range("A" & myrow), 4) = "Run:"

       Set ws = Sheets.Add
       ws.Name = "Data" & mycount
       Sheets("Master").Rows(oldrow & ":" & myrow).Copy ws.Rows(1)
    Loop Until Left(Sheets("Master").Range("A" & myrow + 1), 3) = "xxx"
End Sub