20170821xlVBA跨表公式套用

Public Sub CopyModelHideBlankRows()
    AppSettings
    Dim StartTime As Variant
    Dim UsedTime As Variant
    StartTime = VBA.Timer

    Dim RngAddress As String, Rng As Range, Sht As Worksheet, URows As Range
    Dim RngRow As Long, RngCol As Long, FirstRow As Long
    Const MaxRow As Long = 57
    Set Sht = Application.ActiveSheet
    With Sht

        On Error Resume Next
        Set Rng = Application.InputBox("请选择2号所在的区域", "QQ 84857038", , , , , , 8)
        On Error GoTo 0

        If Rng Is Nothing Then Exit Sub

        RngRow = Rng.Rows.Count
        RngCol = Rng.Columns.Count
        FirstRow = Rng.Cells(1, 1).Row

        If RngRow < MaxRow Then
            Rng.Cells(1, 1).Resize(MaxRow - RngRow, 1).EntireRow.Insert
        End If

        Set Rng = .Cells(FirstRow, "A").Resize(MaxRow, RngCol)
        Debug.Print Rng.Address

        For i = 3 To 31
            EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1
            Rng.Copy .Cells(EndRow, 1)
        Next i

        EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
        For i = 1 To EndRow
            If Application.WorksheetFunction.CountA(.Rows(i)) = 0 Then
                If URows Is Nothing Then
                    Set URows = .Rows(i)
                Else
                    Set URows = Union(URows, .Rows(i))
                End If
            End If
        Next i

        If Not URows Is Nothing Then
            URows.EntireRow.Hidden = True
        End If

    End With
    UsedTime = VBA.Timer - StartTime
    ' Debug.Print "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")
    MsgBox "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")

    AppSettings False
End Sub
Public Sub AppSettings(Optional IsStart As Boolean = True)
    Application.ScreenUpdating = IIf(IsStart, False, True)
    Application.DisplayAlerts = IIf(IsStart, False, True)
    Application.Calculation = IIf(IsStart, xlCalculationManual, xlCalculationAutomatic)
    Application.StatusBar = IIf(IsStart, ">>>>>>>>Macro Is Running>>>>>>>>", False)
End Sub