Offset and end function

I am trying to paste data from Q3 Sheet 1 to Q3 Sheet 2. Each piece of data should be pasted one row below the last piece of data on Q3 Sheet 2 (starting in cell A4). Unfortunately, the line

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

does not do this. Instead it pastes all the data in A4 and they continue to overwrite each other, so that there is only one entry in A4 when there should be multiple entries from A4 all the way up to A14. Please help. Thanks!

  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开发者_如何学Python 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

Only two small changes are needed.

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

should read

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

I've rewritten the code to work with ranges (rather than use a range to get rows then loop row numbers), dimension the variables and with screenupdating off (for speed), plus it is more robust to look up than down when finding the last record

This version copies the entire row from Q3 Sheet 1 to Q3 Sheet 2 if amount owned exceeds 1000. It can be cut back to whatever amount of cells your want (I think you may want two cells?)

[pdate: Tidied code further, added a ws2 variable, removed AmountOwned and redundant 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

Change this line to

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

[]'s

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

Assuming there's no data lower down the sheet in column A