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

<强>后续

这在物理上有效，但由于某种原因，它实际上并没有复制格式（单元格大小等）。它使字体和文本颜色正常，但不是单元格大小或合并单元格或可见边框。

这是你在尝试的吗？

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

Answer 2

在格式化后，查看在您的范围上添加.autofit。这应该解决你的问题。请注意，autofit会拉伸细胞，你不会从中获得“深层”细胞。

必须使用VBA在Excel 2010中复制单元格格式

2 个答案: