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

Question

（1）如果有人可以帮助我，我将不胜感激。 我无法真正弄清楚如何将公式“整个行”包含在下面的代码中，以便宏在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为宏运行的每个工作表创建一个额外的“摘要”工作表。 我不希望为所有找到的范围提供一个摘要表，因为这对于读者来说太混乱了。

非常感谢你！

Answer 1

尝试执行此操作（不确定是否确实需要复制整行吗？）摘要工作表名称只是工作表名称之前的“摘要”。

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