[英]VBA to copy width of the columns
下面的 VBA 代码从源数据表复制数据并将其粘贴到特定表上。 但是,我还需要它来粘贴源数据表上的列宽。 那可能吗? 感谢您的帮助。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tableName As String
Dim tableRange As Range
Dim TypeOfCosts As String
Application.EnableEvents = False
If Range("X1").Text = "aaaa" Then
TypeOfCosts = "_bbbb"
ElseIf Range("L3") = "cccc" Then
TypeOfCosts = "_dddd"
Else
TypeOfCosts = ""
End If
tableName = Range("Y1").Text & TypeOfCosts & "_Costs"
On Error Resume Next
Set tableRange = Application.Range(tableName)
Debug.Print ThisWorkbook.Names.Count
If Not (tableRange Is Nothing) And Err = 0 Then
Range("K9").Resize(10000, 10000).ClearContents
Range("K9").Resize(10000, 10000).ClearFormats
tableRange.Copy Destination:=Range("M8")
Else
Err.Clear
End If
On Error GoTo 0
Application.EnableEvents = True
End Sub
如果您的代码按需要执行,则代替
tableRange.Copy Destination:=Range("M8")
你可以写
tableRange.Copy
With Range("M8")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With
tableRange.Copy Destination:=Range("M8") 是最好的做法,它会跳过可能弄乱东西的剪贴板。 所以你应该保持这种方法。 我宁愿使用一个 interator 来复制范围列宽,如果它们不同,则设置它们。 请参阅我的库中的摘录,该摘录将工作表数据和形状克隆到另一个而不实际破坏引用(使用清除),并且不使用可能在大工作表中失败的复制缓冲区。
' clear all Shapes
For Each varShape In shtNewSheet.Shapes
'console varShape.Name
varShape.Delete
Next
' clear all Cells
With shtNewSheet.UsedRange
' first clear data from current sheet
.Clear
' copy new data and shapes
shtPrevSheet.UsedRange.Copy shtNewSheet.UsedRange.Cells(1)
' as with all things excel, going bakwards actually works
' set columns widths
For i = .Columns.Count To 1 Step -1
If .Columns(i).ColumnWidth <> shtPrevSheet.Columns(i).ColumnWidth Then
.Columns(i).ColumnWidth = shtPrevSheet.Columns(i).ColumnWidth
End If
Next
' optional set rows heights
For i = .Rows.Count To 1 Step -1
If .Rows(i).RowHeight <> shtPrevSheet.Rows(i).RowHeight Then
.Rows(i).RowHeight = shtPrevSheet.Rows(i).RowHeight
End If
Next
' this to reset the selection and move to top page, kind of not really necessary
shtPrevSheet.Cells(1, 1).Copy shtNewSheet.Cells(1, 1)
End With
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.