必须使用 VBA 在 Excel2010 中复制单元格格式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/9538432/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Must copy cell formatting in Excel2010 using VBA
提问by DJOlson
I am attempting to write code to parse a single long spreadsheet into multiple sheets. I have the parse code working, and copy and paste works too. But the paste only creates the cells at the default width. I need to copy ALL cell formatting. That is, cell height, width, background color, foreground color, border etc. That part is generating a run-time 1004 error. Below is my code:
我正在尝试编写代码以将单个长电子表格解析为多个工作表。我有解析代码工作，复制和粘贴也工作。但粘贴仅以默认宽度创建单元格。我需要复制所有单元格格式。也就是说，单元格高度、宽度、背景颜色、前景色、边框等。那部分正在生成运行时 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
I am a very experienced VBA coder, but a complete novice to Excel syntax. Can someone please help me get past this? the "xlPasteAll" attribute fails as well, which is what I tried first using a single PastSpecial method.
我是一个非常有经验的 VBA 编码员，但完全是 Excel 语法的新手。有人可以帮我解决这个问题吗？“xlPasteAll”属性也失败了，这是我首先使用单个 PastSpecial 方法尝试的。
Any ideas would be greatly appreciated!
任何想法将不胜感激！
Thanks
谢谢
回答by Siddharth Rout
Try this
尝试这个
Selection.Copy
Sheets("Data" & mycount).Select
With Range("A1")
.PasteSpecial xlValues
.PasteSpecial xlPasteFormats
End With
FOLLOWUP
跟进
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.
这在物理上有效，但由于某种原因，它实际上并没有复制格式（单元格大小等）。它使字体和文本颜色正常，但不是单元格大小或合并单元格或可见边框。
Is this what you are trying?
这是你正在尝试的吗？
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
回答by Durley
Look at adding an .autofit on your range after formatting. That should sort out your problem. Be aware that autofit will stretch cells, you will not get "deep" cells from it.
看看在格式化后在你的范围内添加一个 .autofit 。那应该可以解决您的问题。请注意，自动调整会拉伸单元格，您不会从中获得“深”单元格。
