Копировать-Вставить от Min до Max
Это может быть простой вопрос, но после нескольких часов попыток сдаться …
Я хочу, чтобы макрос находил диапазон от минимума до максимума. Этот диапазон должен быть скопирован и вставлен в какой-то «сводный лист».
Я смог заставить макрос найти min и max, и я также получил инструкцию copy-paste, которая работает.
- Вставить выходы Python (0,25, 0,78, 0,33, ...) в ячейки Excel
- Копировать только видимые ячейки
- Простой способ скопировать формулу, расширяющую исходную строку на 1?
- Макросы Vba в Excel - Range.Validation.Type Причины 1004
- VBA с смещением диапазона
Может ли кто-нибудь помочь мне объединить эти инструкции в один?
Вот мой макрос, насколько я пришел:
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 Спасибо!!
- Excel Копировать и вставить при подтверждении данных
- Формы (неизвестный член) Вставка из Excel в Powerpoint
- VBA Копировать значения из одной книги в другую, где значение соответствует?
- Массовое вложение таблиц Microsoft Excel в Microsoft Word
- Цикл «If Then» с копией и вставкой
- VBA - вставить как значения
- VBA, если файл не найден, создает и вставляет данные
- Код Excel VBA для копирования / вставки (транспонирования) различного диапазона значений в цикле на другой лист
Я бы сделал следующее:
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
Может быть немного быстрее оценить выражение непосредственно (проверено):
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