Excel VBA - Как скопировать несколько диапазонов заданных условий на новый лист

Question

Я очень новичок в VBA. У меня есть лист с несколькими диапазонами, который я хотел бы скопировать и вставить в существующую электронную таблицу на основе определенных условий. Я пытался отработать подобную тему здесь , но все еще испытываю трудности. Мне бы хотелось, чтобы каждый скопированный диапазон вставлялся ниже последней строки с интервалом в 1 строку между ними.

Для целей этой цепочки предположим, что sourceSheet - это имя листа со всеми данными, а targetSheet - это лист, который я пытаюсь построить для

. Для первой функции я Я хотел бы найти две ячейки, "A67" для имени и "B117" для числа. Эти два параметра (номер и имя) связаны с диапазоном копируемой ячейки (A68: K125). Каждое имя, номер и диапазон смещены на 11 столбцов (первое имя в A67, следующее в L67). Существует 50 наборов диапазонов, все смещены на 11 столбцов, но я бы хотел, чтобы при добавлении дополнительных диапазонов программа могла их также оценить.

Я пытаюсь определить максимальное число, связанное с данным именем, и построить соответствующий диапазон на основе этого.

Пример. [Боб, 15] [Джон, 16] [Джон, 22] [Боб, 35] [Боб, 12]

копировать и вставлять диапазон, связанный с [Боб, 35] и диапазон, связанный с [Джон, 22 ]

---

Вторая функция будет смотреть только на число и копировать соответствующий диапазон. Я хотел бы выполнить поиск в ячейке «G195», чтобы увидеть, является ли она «НЕ» 0. Если это любое число, кроме нуля, оно построит соответствующий диапазон (A162: K191). Каждое число и диапазон смещены на 11 столбцов (первый номер в G195, следующий в R195). Существует 50 наборов диапазонов, все смещены на 11 столбцов, но я бы хотел, чтобы при добавлении дополнительных диапазонов программа могла их также оценить.

Я работал над более простой функцией, но по какой-то причине формат не сохранился. Я хотел бы перенести формат (шрифт, размер, полужирный, цветные ячейки), но он не работал. Кроме того, у меня есть некоторые изображения, которые находятся внутри этих ячеек диапазона, которые не копируются.

Любая помощь будет высоко ценится. Я разместил код, который я написал для второй функции. Я понятия не имею, как написать первую функцию.

Sub Copy_Electrical_Calcs()

'
' Copy_Electrical_Calcs Macro
'
Application.ScreenUpdating = False
Dim rngToCopy As Range
Dim variableRange As Range
Dim i As Long
Dim lastrow As Long
Dim fileName As Long
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim variable As String

Set targetSheet = Worksheets("targetSheet")

With ThisWorkbook.Worksheets("sourceSheet")
    Set rngToCopy = .Range("A162:K191")
    Set variableRange = .Range("G195")
End With
For i = 1 To 4
    if(variableRange <> 0)
    lastrow = Range("F65536").End(xlUp).Row
    Sheets("targetSheet").Range(lastrow + 1).Resize(rngToCopy.Rows.count, rngToCopy.Columns.count).Value = rngToCopy.Value
    variableRange.ClearContents

    ' Increment our ranges:
    Set variableRange = variableRange.Offset(0, 11)
    Set rngToCopy = rngToCopy.Offset(0, 11)
Next
ThisWorkbook.Save

End Sub