必須使用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中的單元格格式

回答

相關問題