[發問] 複製後無法照原格式貼上???列高欄寬並沒有被覆製???

t8899

這是錄製之巨集，執行後每個儲存格的列高欄寬並沒有被覆製???
    Sheets("Sheet8").Select
    Range("A1:D17").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("G6").Select
Book2.rar (9.34 KB)

下載次數: 2

2017-6-29 21:21

t8899

找到 luhpro 之前po的帖，但目的地跟來源不在同一張工作表會無效,不知如何改??

Sub nn()
  Dim lJ&, lSrc&, lTrc&, lrcs&
  Dim rSou As Range, rTar As Range
  
  Set rSou = Sheets("Sheet6").[A1:g33]' 來源
  Set rTar =Sheets("Sheet8").[a10] ' 目的
  
  rSou.Copy rTar ' 拷貝
  
'===== 逐欄複製欄寬===
  lSrc = rSou(1).Column
  lTrc = rTar(1).Column
  lrcs = rSou.Columns.Count - 1
  For lJ = 0 To lrcs
    Columns(lTrc + lJ).ColumnWidth = Columns(lSrc + lJ).ColumnWidth
  Next
  
'===== 逐列複製列高===
  lSrc = rSou(1).Row
  lTrc = rTar(1).Row
  lrcs = rSou.Rows.Count - 1
  For lJ = 0 To lrcs
    Rows(lTrc + lJ).RowHeight = Rows(lSrc + lJ).RowHeight
  Next
End Sub

ML089

回復 1# t8899

可以用巨集錄製

Sub ex()
    Dim rSou As Range, rTar As Range
    Set rSou = Sheets("Sheet8").Range("A1:D17")
    Set rTar = Sheets("sheet2").Range("G6")
    rSou.Copy rTar
    With rTar
        rSou.Copy
        .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                      SkipBlanks:=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                      SkipBlanks:=False, Transpose:=False
    End With
End Sub

t8899

回復  t8899

可以用巨集錄製

Sub ex()
    Dim rSou As Range, rTar As Range
    Set rSou = She ...
ML089 發表於 2017-6-30 10:52

可以了謝謝
本來想用 [a16].RowHeight = [a1].RowHeight 一個個解決
有這個語法  ===>  xlPasteColumnWidths
但確沒有這個語法 ==> xlPasteRowHeight
xlPasteFormats 含 xlPasteRowHeight ??

t8899

回復  t8899

可以用巨集錄製

Sub ex()
    Dim rSou As Range, rTar As Range
    Set rSou = She ...
ML089 發表於 2017-6-30 10:52

我又詳細測了一下  ,列高有些仍沒辦法拷 ?? Book4.rar (11.79 KB)

下載次數: 1

2017-6-30 12:33

ML089

回復 5# t8899

儲存格高度沒有複製選項，只好自己做

Sub ex1()
    Dim rSou As Range, rTar As Range
    Set rSou = Sheets("Sheet4").Range("A1:d33")
    Set rTar = Sheets("sheet1").Range("a1")
    rSou.Copy rTar
    With rTar
        rSou.Copy
        .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                      SkipBlanks:=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                      SkipBlanks:=False, Transpose:=False
    End With

    For j = 1 To rSou.Rows.Count: rTar(j, 1).RowHeight = rSou(j, 1).RowHeight: Next

End Sub