我试图将行高从一张纸复制到另一张纸

时间:2018-03-28 20:45:49

标签: excel vba excel-vba excel-2010 copy-paste

我正在尝试将行高从一个sheet1复制到sheet2。但以下代码无效。请注意,两张表上的表格也在不同的行号上。

Call Unhide

With Sheet1

    Dim LastRowC23 As Integer
    LastRowC23 = Application.WorksheetFunction.Match("CYCLE 1", 
    .Range("A:A"), 0) - 1

    Dim LastRow As Integer
    LastRow = .Cells(.Rows.count, "B").End(xlUp).Row

    .Range("A3:BD3"), 0)

    Dim C1StartCol As Integer
    C1StartCol = Application.WorksheetFunction.Match("CYCLE 1", 
    .Range("A1:BD1"), 0)

    Dim C2StartCol As Integer
    C2StartCol = Application.WorksheetFunction.Match("CYCLE 2", .Range("A1:BD1"), 0)

    Dim LastCol As Integer
    LastCol = .Cells(3, .Columns.count).End(xlToLeft).Column

    Sheet2.Range("A1:CZ200").Clear

    .Range("A1", .Cells(3, C2StartCol - 1)).Copy
    Sheet2.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    Sheet2.Range("A1").PasteSpecial xlPasteColumnWidths
    .Range(.Cells(LastRowC23 + 1, 1), .Cells(LastRow - 1, C2StartCol - 1)).Copy
    Sheet2.Range("A4").PasteSpecial xlPasteAllUsingSourceTheme
    Sheet2.Range("A4").PasteSpecial xlPasteColumnWidths

    Dim i As Integer
    Dim count As Integer

    count = 4

    For i = LastRowC23 + 1 To LastRow
        .Rows(count).RowHeight = Sheet2.Rows(i).RowHeight
        count = count + 1
    Next i



    Sheet2.Outline.ShowLevels ColumnLevels:=1

End With

以下是特定于行高的部分。在这里,我将浏览工作表1部分中的每一行,并使工作表2行高度等于工作表1行高度。

    Dim i As Integer
    Dim count As Integer

    count = 4

    For i = LastRowC23 + 1 To LastRow
        .Rows(count).RowHeight = Sheet2.Rows(i).RowHeight
        count = count + 1
    Next i

1 个答案:

答案 0 :(得分:1)

您位于With ... End With块中,它将sheet1作为父工作表引用。 LastRowC23和LastRow由sheet1上的行位置定义。计数被任意赋值为4。

如果您'使表格2行高度等于表格1行高度,那么您似乎正在向后使用所有内容。

For i = LastRowC23 + 1 To LastRow
    Sheet2.Rows(count).RowHeight = .Rows(i).RowHeight
    count = count + 1
Next i