Question

我有以下代码，它们查看每列第80行的原始工作表，如果它有文本＆＃34; True＆＃34;它将该列复制到目标工作表。然后它循环并遍历所有列。它工作得很完美，除了我无法弄清楚如何复制列宽。 - 乔丹

'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

使用调整大小和复制来复制列宽

1 个答案: