使用resize和复制复制列宽

我有以下代码，查看每个列的第80行上的原始工作表，如果它具有文本“True”它将该列复制到目标工作表。 然后循环遍历所有的列。 它工作完美，除了我不知道如何复制列的宽度。 – 约旦

'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 

Answer 1

 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