Copy Column Widths Using Resize and Copy

I have the following code which looks at the original sheet at line 80 of each column and if it has the text "True" it copies that column to the destination sheet. Then it loops and goes through all the columns. It works fine, but I can't figure out how to copy the column width. - Jordan

'Called from AddWorksheet
Sub CopyFinal(orgSheet As Worksheet, destSheet As Worksheet)

Dim j As Integer '**Why is j an Integer and others are Long?
Dim lastColumn As Long
Dim benRow As Long

j = 2
lastColumn = 2
'Counts the number of benefits on each sheet.  Assumes that they will not go past row 40
benRow = WorksheetFunction.CountA(orgSheet.Range("B3:B40"))

Application.ScreenUpdating = False

Do Until IsEmpty(orgSheet.Cells(3, j))
    If orgSheet.Cells(80, j) = True Then
        orgSheet.Cells(3, j).Resize(benRow).Copy destSheet.Cells(3, lastColumn) '**Need to paste column widths
    End If
    j = j + 1
    lastColumn = destSheet.UsedRange.Columns(destSheet.UsedRange.Columns.Count).Column + 1
Loop

Application.ScreenUpdating = True
End Sub

      

+3


source to share


1 answer


Do Until IsEmpty(orgSheet.Cells(3, j))
    If orgSheet.Cells(80, j) = True Then
        orgSheet.Cells(3, j).Resize(benRow).Copy
        With destSheet.Cells(3, lastColumn)
            .Paste
            .PasteSpecial Paste:=xlPasteColumnWidths
        End With
    End If
    j = j + 1
    lastColumn = destSheet.UsedRange.Columns(destSheet.UsedRange.Columns.Count).Column + 1
Loop

      



+6


source







All Articles