VBA復制列的寬度

Question

下面的 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

Answer 1

如果您的代碼按需要執行，則代替

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

Answer 2

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