简体   繁体   中英

VBA to copy width of the columns

The VBA code below copies the data from a source data sheet and pastes it onto a specific sheet. However, I need it to also paste the width of the columns on the source data sheet. Would that be possible? thanks for any help.

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

If your code is executing as desired then instead of

tableRange.Copy Destination:=Range("M8")

you may write

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") is best practive, it will skip the clipboard that can mess up stuff. So you should keep the approach. I will rather use an interator for copyrange column widths and set them if they are different. See below an extract from my library that clones a sheet data and shapes to another without actually breaking references (using clear) and without using the copy buffer that might fail in large sheets.

' 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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM