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

Question

Я начну с того, что я очень новичок в VBA в Excel и самоучка.У меня есть таблица для записи часов тренировок.Я пытаюсь написать код, который ищет непустую ячейку в 3 столбцах, которые "A", "B" или "A & B".Как только код обнаружит непустой столбец, я хочу, чтобы он затем выбрал определенный диапазон (скажем, A1: C1 & D1 & F1: J1), но в строке непустой ячейки ему необходимо скопировать эти значения влибо лист A, лист B или оба листа A и B, в зависимости от того, какой столбец имеет значение.Я хочу, чтобы он вставил следующую пустую строку на этих листах (после очистки листа, чтобы у меня не было дубликатов) в диапазон, скажем, A1: F1 (извините, эти диапазоны являются приблизительными значениями).Затем мне нужен этот код для циклического прохождения каждой строки, которая не является полностью пустой с первых листов.

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

Пока я пробовал:

'Sub Macro1()
''    Dim r1, r2, r3, myMultipleRange As Range
''    Set r1 = Sheets("Record").Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, -2))
''    Set r2 = Sheets("Record").Range(ActiveCell.Offset(0, 0))
''    Set r3 = Sheets("Record").Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5))
''    Set myMultipleRange = Union(r1, r2, r3)
'    Sheets("Record").Select
'    Range("D4:D6").Select
'    Selection.End(xlDown).Select
'    Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
''    myMultipleRange.Select
'End Sub

Sub Macro1()
    Dim r1, r2, r3, myMultipleRange As Range
    Set r1 = Sheets("Record").Range("A4:b4")
    Set r2 = Sheets("Record").Range("D4")
    Set r3 = Sheets("Record").Range("F4:I4")
    Set myMultipleRange = Union(r1, r2, r3)
    myMultipleRange.Select

End Sub

Я хочу, чтобы первый лист был разбит на другие соответствующие листы, чтобы можно было извлечь итоги и всю другую информацию в этой строке

Это вкладка ввода "Запись" Вкладка ввода

И это одна из двух вкладок вывода «CPD» (другая - «Вне обучения»)

Вкладка вывода

Редактировать: я получил немного дальше с этим сейчас.Вместо того, чтобы пытаться выбрать весь диапазон сразу, я пытаюсь скопировать каждую часть отдельно.Если я прокомментирую, я не уверен, как я смогу сделать это, чтобы пройти через все строки и три столбца, которые являются переменными, хотя, какие-нибудь мысли?

Sub Macro1()
    Sheets("CPD").Select
    Range("H7:N1449").Select
    Selection.ClearContents
    Sheets("Record").Select
    Range("D4:D6").Select
    Selection.End(xlDown).Select
    Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, -2)).Select
    Selection.Copy
    Sheets("CPD").Select
    Range("H3:K3").Select
    Selection.End(xlDown).Offset(1, 0).Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Select
    ActiveSheet.Paste
        Sheets("Record").Select
        Range("D4:D6").Select
        Selection.End(xlDown).Select
        Selection.Copy
        Sheets("CPD").Select
        Range("H3:K3").Select
        Selection.End(xlDown).Offset(1, 2).Select
        ActiveSheet.Paste
            Sheets("Record").Select
            Range("D4:D6").Select
            Selection.End(xlDown).Select
            Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
            Selection.Copy
            Sheets("CPD").Select
            Range("H3:K3").Select
            Selection.End(xlDown).Offset(1, 3).Select
            ActiveSheet.Paste
End Sub

Answer 1

Хорошо, после небольшого количества проб и ошибок, я думаю, мне удалось найти рабочее решение.Не стесняйтесь проверить мой код, хотя!

Sub Calculate()
    Dim x As Long
        Sheets("CPD").Select
        Range("H7:N1449").Select
        Selection.ClearContents
        Sheets("Off the job training").Select
        Range("H7:N1449").Select
        Selection.ClearContents
            For x = 1 To 50
            Sheets("Record").Select
            Range("C7").Offset(x - 1, 0).Select
                If IsEmpty(ActiveCell) Then
                    Range("D7").Offset(x - 1, 0).Select
                        If IsEmpty(ActiveCell) Then
                            Range("E7").Offset(x - 1, 0).Select
                                If IsEmpty(ActiveCell) Then
                                    Exit For
                                Else
                                    Range(ActiveCell.Offset(0, -4), ActiveCell.Offset(0, -3)).Select
                                    Selection.Copy
                                    Sheets("CPD").Select
                                    Range("H500").Select
                                    Selection.End(xlUp).Offset(1, 0).Select
                                    ActiveSheet.Paste
                                    Sheets("Off the job training").Select
                                    Range("H500").Select
                                    Selection.End(xlUp).Offset(1, 0).Select
                                    ActiveSheet.Paste
                                        Sheets("Record").Select
                                        Range("E7").Offset(x - 1, 0).Select
                                        Selection.Copy
                                        Sheets("CPD").Select
                                        Range("H500").Select
                                        Selection.End(xlUp).Offset(0, 2).Select
                                        ActiveSheet.Paste
                                        Sheets("Off the job training").Select
                                        Range("H500").Select
                                        Selection.End(xlUp).Offset(0, 2).Select
                                        ActiveSheet.Paste
                                            Sheets("Record").Select
                                            Range("E7").Offset(x - 1, 0).Select
                                            Range(ActiveCell(1, 2), ActiveCell(1, 5)).Select
                                            Selection.Copy
                                            Sheets("CPD").Select
                                            Range("H500").Select
                                            Selection.End(xlUp).Offset(0, 3).Select
                                            ActiveSheet.Paste
                                            Sheets("Off the job training").Select
                                            Range("H500").Select
                                            Selection.End(xlUp).Offset(0, 3).Select
                                            ActiveSheet.Paste
                                End If
                        Else
                            Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0, -2)).Select
                            Selection.Copy
                            Sheets("Off the job training").Select
                            Range("H500").Select
                            Selection.End(xlUp).Offset(1, 0).Select
                            ActiveSheet.Paste
                                Sheets("Record").Select
                                Range("D7").Offset(x - 1, 0).Select
                                Selection.Copy
                                Sheets("Off the job training").Select
                                Range("H500").Select
                                Selection.End(xlUp).Offset(0, 2).Select
                                ActiveSheet.Paste
                                    Sheets("Record").Select
                                    Range("D7").Offset(x - 1, 0).Select
                                    Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 5)).Select
                                    Selection.Copy
                                    Sheets("Off the job training").Select
                                    Range("H500").Select
                                    Selection.End(xlUp).Offset(0, 3).Select
                                    ActiveSheet.Paste
                        End If
                Else
                    Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, -1)).Select
                    Selection.Copy
                    Sheets("CPD").Select
                    Range("H500").Select
                    Selection.End(xlUp).Offset(1, 0).Select
                    ActiveSheet.Paste
                        Sheets("Record").Select
                        Range("C7").Offset(x - 1, 0).Select
                        Selection.Copy
                        Sheets("CPD").Select
                        Range("H500").Select
                        Selection.End(xlUp).Offset(0, 2).Select
                        ActiveSheet.Paste
                            Sheets("Record").Select
                            Range("C7").Offset(x - 1, 0).Select
                            Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 6)).Select
                            Selection.Copy
                            Sheets("CPD").Select
                            Range("H500").Select
                            Selection.End(xlUp).Offset(0, 3).Select
                            ActiveSheet.Paste
                End If
            Next x
End Sub