从最小到最大的复制粘贴范围（包括整行）

Question

(1) 如果有人能简单地帮助我，我将不胜感激。我真的不知道如何将公式 "entire row" 包含到下面的代码中，以便宏在 F 列中从 min 复制到 max 以及每个数据点的整行...

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

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

For Each sht In Worksheets
   If sht.Name <> summarySht.Name Then
        With sht.Range("F15000:F20000")
            .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

(2)另外一个问题是，如何修改代码，让excel为每个sheet宏运行时额外创建一个"summary"sheet .我不想要所有找到的范围的摘要sheet，因为这对于 reader.

来说太混乱了

非常感谢！

Answer 1

试试这个（不确定您是否真的需要复制整行，对吗？）摘要 sheet 名称只是 sheet 名称前面有 "Summary"。

Sub x()

Dim sht As Worksheet, summarySht As Worksheet
Dim rMin As Range, rMax As Range

For Each sht In Worksheets
   If Not sht.Name Like "Summary*" Then
        Set summarySht = Sheets.Add(after:=Sheets(Sheets.Count))
        summarySht.Name = "Summary " & sht.Name
        With sht.Range("F15000:F20000")
            Set rMin = .Find(what:=WorksheetFunction.Min(.Cells), lookat:=xlWhole, LookIn:=xlValues)
            Set rMax = .EntireColumn.Find(what:=WorksheetFunction.Max(.EntireColumn))
            .Parent.Range(rMin, rMax).EntireRow.Copy summarySht.Range("A1")
        End With
   End If
Next sht

End Sub

从最小到最大的复制粘贴范围（包括整行）

Copy-Paste range (inc. entirerow) from Min to Max

excel

vba

copy-paste