复制粘贴范围从最小到最大

Question

这可能是一个简单的问题，但经过数小时的尝试放弃之后...

我希望宏查找从最小到最大的范围。 该范围应复制并粘贴到某种“摘要表”中。

我能够使宏找到最小值和最大值，并且我也得到了复制粘贴指令。

有人可以帮我将这些说明合二为一吗？

这是我来的宏：

Sub Enter_Formula()

    Dim blatt
    Dim sheetName As String
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range("=Min(A59:A86):=Max(A:A)").Copy Range("C1")
    Next

End Sub

谢谢！！

Answer 1

我将按照以下步骤进行：

Sub Enter_Formula()
    Dim sht As Worksheet, summarySht As Worksheet

    Set summarySht = Worksheets("Summary") '<--| change "Summary" to your actual "Summary" sheet name

    For Each sht In Worksheets
       If sht.Name <> summarySht.Name Then
            With sht.Range("A59:A86")
                .Parent.Range(.Find(what:=WorksheetFunction.Min(.Cells), lookat:=xlWhole, LookIn:=xlValues), .EntireColumn.Find(what:=WorksheetFunction.Max(.EntireColumn), lookat:=xlWhole, LookIn:=xlValues)).Copy summarySht.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
            End With
       End If
    Next
End Sub

Answer 2

直接评估表达式（测试）可能会更快一些：

Dim ws As Worksheet

For Each ws In Worksheets
    ws.Range("Index(A59:A86,Match(Min(A59:A86),A59:A86,0)):Index(A:A,Match(Max(A:A),A:A,0))").Copy ws.Range("C1")
Next