必须使用VBA复制Excel2010中的单元格格式

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

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方法尝试的。

任何想法将不胜感激！

感谢

来源

2012-03-02 DJOlson

试试这个

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

来源

2012-03-02 18:38:45

这在物理上有效，但由于某些原因，它实际上并未复制格式（单元格大小等）。它可以获取字体和文本颜色，但不包含单元格大小或合并单元格或可见边框。 – DJOlson 2012-03-02 20:31:14

@DJOlson：发布更新超过 – 2012-03-02 20:39:12

删除。不能粘贴代码。 – DJOlson 2012-03-05 21:11:12

看看在格式化后在范围中添加.autofit。这应该解决你的问题。请注意，自动适应会拉伸细胞，你不会从它得到“深”细胞。

来源

2013-03-08 14:26:27 Durley

必须使用VBA复制Excel2010中的单元格格式

回答

相关问题