Смещение и конец функции

Question

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

Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0) 

не делает этого.Вместо этого он вставляет все данные в A4, и они продолжают перезаписывать друг друга, так что в A4 имеется только одна запись, когда должно быть несколько записей от A4 до A14.Пожалуйста помоги.Спасибо!

  With Worksheets("Q3 Sheet 1").Range("A3")
        'Count total number of entries
        nCustomers = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
        'Loop through all entries looking for amounts owed > 1000
        For iRow = 1 To nCustomers
            AmountOwed = .Offset(iRow, 1) - .Offset(iRow, 2)
            'If amount owed > 1000 then transfer customer ID and amount owing to Q3 Sheet 2
            If AmountOwed > 1000 Then
                Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

            End If
        Next iRow
    End With

Answer 1

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

Эта версия копирует всю строку с листа Q3 на лист Q3, если сумма владения превышает 1000. Она может быть сокращена до любого количества ячеек, которое вы хотите (я думаю, что вы хотите две ячейки? )

[pdate: далее прибрано код, добавлена ​​переменная ws2, удалено AmountOwned и избыточно nCustomers]

   Sub Update()
   Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Application.ScreenUpdating = False
    Set ws = Worksheets("Q3 Sheet 1")
    Set ws2 = Worksheets("Q3 Sheet 2")
    Set rng1 = ws.Range(ws.[a4], ws.Cells(Rows.Count, "A").End(xlUp))
    For Each rng2 In rng1
        'If amount owed > 1000 then transfer customer ID and amount owing to Q3 Sheet 2
        If rng2.Offset(0, 1) - rng2.Offset(0, 2) > 1000 Then rng2.EntireRow.Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next
    Application.ScreenUpdating = True        
    End Sub

Answer 2

Требуются только два небольших изменения.

Worksheets("Q3 Sheet 2").Range("A3").End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

следует читать

Worksheets("Q3 Sheet 2").Range("A2").End(xlDown).Offset(1, 0) = .Offset(iRow, 0)

Answer 3

Worksheets("Q3 Sheet 2").cells(rows.count,1).End(xlUp).Offset(1, 0) = .Offset(iRow, 0)

Предполагается, что в столбце A * 1002 нет данных ниже на листе

Answer 4

Измените эту строку на

Worksheets("Q3 Sheet 2").Range("A3").End(xlDown).Offset(1, 0) = .Offset(iRow, 0) 

[] s