麻辣家族討論版版 - Powered by Discuz! Board

標題: 複製範圍可連同欄寬或列高複製嗎? [打印本頁]

作者: enoch 時間: 2016-4-24 19:08 標題: 複製範圍可連同欄寬或列高複製嗎?

請問在Copy Range 時, 可以連同欄寬或列高複製嗎?
請指教

作者: luhpro 時間: 2016-4-27 22:42

請問在Copy Range 時, 可以連同欄寬或列高複製嗎?
請指教
enoch 發表於 2016-4-24 19:08

可以靠程式來達成 :

Sub nn()
Dim lJ&, lSrc&, lTrc&, lrcs&
Dim rSou As Range, rTar As Range
Set rSou = [A2:E13]' 來源
Set rTar = [G16] ' 目的
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

複製代碼

作者: t8899 時間: 2017-6-30 06:09

可以靠程式來達成 :
luhpro 發表於 2016-4-27 22:42

目地的在不同的工作表好像無效???

作者: ML089 時間: 2017-6-30 11:43

欄寬及格式複製可以使用 "選擇性貼上"，勾選欄寬及格式
可以錄製巨集如下

Sub 複製含欄寬及格式()
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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)