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

Question

这可能是一个简单的问题，但经过几个小时的努力后，我几乎要放弃了...

我希望宏找到从最小值到最大值的范围。这个范围应该被复制并粘贴到某种 "summary sheet".

我能够让宏找到最小值和最大值，而且我还得到了一个有效的复制粘贴指令。

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

这是我的宏：

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

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

Copy-Paste Range from Min to Max

excel

vba

copy-paste