Копирование нескольких диапазонов в следующую доступную строку

Question

Я вернулся!Итак, я копирую строки данных из одной электронной таблицы в другую нажатием кнопки, когда ячейка «Да», и удаляю исходную строку данных.У меня есть несколько диапазонов, которые я копирую из одной строки, потому что для второй электронной таблицы не нужны все данные, хранящиеся в первой.(Первая электронная таблица содержит более 20 столбцов данных, а вторая - вдвое меньше).Есть ли простой способ убедиться, что все это скопировано в одну и ту же строку в новой электронной таблице?

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

Private Sub CommandButton1_Click()

Dim c As Range
Dim r As Integer
Dim LastRowD
Dim LastRowR
Dim Database As Worksheet
Dim DeReg As Worksheet


    'Set worksheet deignation as needed
    Set Database = ActiveWorkbook.Worksheets("Fostering Households")
    Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")

    LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row

    'Searches all rows in I
    For Each c In Database.Range("I1:I" & LastRowD)

        'Catches cases where "Yes" is present in column I
        If c = "Yes" Then

            LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
            r = c.Row

            'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
            Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("H" & r).Copy DeReg.Range("AJ" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("AN" & r).Copy DeReg.Range("W" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("AS" & r).Copy DeReg.Range("X" & Rows.Count).End(xlUp).Offset(1, 0)
            Database.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)

        End If


    Next c

    For i = 250 To 1 Step -1

        If Database.Range("I" & i) = "Yes" Then
            Database.Rows(i).EntireRow.Delete
        End If

    Next i



End Sub

Я пытался определить последнюю строку на основе того, есть ли в «А» данные (это единственная ячейка, которая всегда используется) с кодом:

LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)а затем заменив код моей копии в прошлом на:

Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR & ":B" & LastRowR).Row

Но это не сработало вообще - оно скопировало первую найденную строку с «Да» бесконечно и переписало вседанные уже присутствуют.Я также попробовал:

Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR).PasteSpecial

, что также сопровождалось миром проблем и ошибок.То, что я хочу, это искать последнюю использованную строку на основе того, что находится в столбце A, смещено на 1, а затем после данных в столбце, который я обозначаю, а не на последнюю использованную строку, определенную столбцом, который я пытаюсь вставитьв - это вообще выполнимо?Я не могу найти какую-либо информацию по этому конкретному вопросуКроме того, если есть лучший способ обработки нескольких диапазонов, это было бы здорово, поскольку это кажется довольно запутанным в настоящее время!Спасибо <3 </p>

Answer 1

Несколько полезных советов:

1. i не объявлено. Объявить как Long.
2. LastRowR, r & LastRowD должны быть объявлены как Long.
3. Заменить ActiveWorkbook на ThisWorkbook.
4. Используемый метод копирования-вставки может замедлить работу программы, поскольку этот метод копирует и вставляет как значения, так и форматирование.
5. Если вы хотите вставить строку после последней строки, используйте +1 (пример: LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row +1

Answer 2

DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) оценивается как:

DeReg.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0), поэтому, если DeReg не является активным листом, вы получите неправильный диапазон.

Проверьте, поможет ли это:

.... other code
'LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row

'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab

    With Database
        LastRowR = DeReg.Range("A" & DeReg.Rows.Count).End(xlUp).Row + 1

        .Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR)
        .Range("H" & r).Copy DeReg.Range("AJ" & LastRowR)
        .Range("J" & r & ":X" & r).Copy DeReg.Range("H" & LastRowR)
        .Range("AN" & r).Copy DeReg.Range("W" & LastRowR)
        .Range("AS" & r).Copy DeReg.Range("X" & LastRowR)
        .Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & LastRowR)
    End With

End If
... other code

Answer 3

Просто пара мыслей. Во-первых, вы объявили несколько вещей, которые не нужны (IMO). Я настроил ваш цикл for так, чтобы он просто перебирал значение, которое затем ссылается на нужный вам диапазон. Таким образом, вы можете использовать значение i намного эффективнее, чем сначала установить диапазон, а затем выполнить цикл и ссылаться на строку и т. Д.

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

Option Explicit

Private Sub CommandButton1_Click()

Dim i As Long
Dim LastRowD As Long
Dim LastRowR As Long
Dim Database As Worksheet
Dim DeReg As Worksheet

'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")

LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row

'Searches all rows in I
For i = 1 To LastRowD
    'Catches cases where "Yes" is present in column I
    If Database.Range("I" & i) = "Yes" Then

        LastRowR = Database.UsedRange.Rows.Count + 1

        'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
        Database.Range("A" & i & ":G" & i).Copy DeReg.Range("A" & LastRowR)
        Database.Range("H" & i).Copy DeReg.Range("AJ" & LastRowR)
        Database.Range("J" & i & ":X" & i).Copy DeReg.Range("H" & LastRowR)
        Database.Range("AN" & i).Copy DeReg.Range("W" & LastRowR)
        Database.Range("AS" & i).Copy DeReg.Range("X" & LastRowR)
        Database.Range("AZ" & i & ":BH" & i).Copy DeReg.Range("Y" & LastRowR)

    End If

Next i

For i = 250 To 1 Step -1

    If Database.Range("I" & i) = "Yes" Then
        Database.Rows(i).EntireRow.Delete
    End If

Next i

End Sub