excel - VBA - Copy/paste 2 blocks of rows if condition to one row is met

Question

good morning!

I'm trying to:

1 - Loop all my sheets, starting from the 2nd sheet (until here it's working);

2 - Find Max, Min Value and Interval (Max-Min Value/4), assign to cells, and define 3 more intervals iQ1, iQ2 and iQ3. This way I goot all the intervals I need to build 4 quantiles (until here it's working too);

3 - Now, in each sheet and in the same loop, I need to search in column F for all the values of the column that are <= iQ1 (and creater other conditions for other intervals (iQs)). If those values in the loop are <=Q1, for instance, I need to copy and paste all of them and their quantity (Column G) in the columns J2:J (for interest) and K2:K (for quantity). I create a picture to explain better.

I need this because I'll need to calculate the median of each quantile after.

I tried the first loop only for the column F to try, but it failed this and other things that I tried. Could you help me with item 3, please?

Thanks and have a great day!

Application.ScreenUpdating = False

Dim ws2 As Worksheet
Dim x As Long, Interval As Double, MaxValue As Double, MinValue As Double, iQ1 As Double, iQ2 As Double, iQ3 As Double, rw2 As Object

For x = 2 To Sheets.Count
    Sheets(x).Activate
    
    Dim c As Range
    Set c = Range("F2:F" & Rows.Count)
        MaxValue = Application.WorksheetFunction.Max(c)
        MinValue = Application.WorksheetFunction.Min(c)
        Interval = (MaxValue - MinValue) / 4
        Sheets(x).Range("I2").Value = Interval
        Sheets(x).Range("P2").Value = MaxValue
        Sheets(x).Range("O2").Value = MinValue
        Sheets(x).Range("J2:M500000").Clear
        iQ1 = MinValue + Interval
        iQ2 = iQ1 + Interval
        iQ3 = iQ2 + Interval
        
        For Each rw2 In Sheets(x).Range(c) 'Here is the loop that I'm stucked
            If rw2.Cells(6).Value <= iQ1 Then 'Here is the condition blue for F, it's in the picture 
                With Sheets(x)
                rw2.EntireRow.Copy
                .Cells(.Rows.Count, "J2:J").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End With
            End If
        Next rw2

Next x

Application.ScreenUpdating = True

Answer 1

You had nearly the correct structure, and hopefully the points below will help you keep things straight.

First, you can loop through all the sheets in your workbook a bit simpler with the sample here, including skipping a particular sheet if you need to:

Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
    If Not ws.Name = "SKIP THIS SHEET" Then
        With ws
            ...
        End With
    End If
Next ws

Using a loop like this, you can be assured that ws as always the worksheet that is operated on. Notice the With statement here and always make sure to preface your references to Range or Cells with the dot . to make sure it's working on that ws worksheet.

Next, it's good practice to declare your variables closer to the point where they are first used and to put each variable on its own line. This can be a personal preference of course, but it's currently the most common habit.

Where your inner loop is not working is how you're referencing the different data. In my example below, each of the Quartil ranges is defined clearly. Also, I'm using more descriptive variable names to indicate what data I'm currently working on. Finally, it was easier to break out a separate routine to append the interest data in a particular quartil, in order to show how common code sections can be isolated in a function/sub.

Option Explicit

Sub test()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets
        If Not (ws.Name = "SKIP THIS SHEET") Then
            With ws
                Dim interestData As Range
                Dim lastRow As Long
                lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
                Set interestData = .Range("F2:F" & lastRow)
                
                Dim Interval As Double
                Dim MaxValue As Double
                Dim MinValue As Double
                Dim iQ1 As Double
                Dim iQ2 As Double
                Dim iQ3 As Double
                MaxValue = Application.WorksheetFunction.Max(interestData)
                MinValue = Application.WorksheetFunction.Min(interestData)
                Interval = (MaxValue - MinValue) / 4
                .Range("I2").Value = Interval
                .Range("R2").Value = MaxValue
                .Range("S2").Value = MinValue
                .Range("J2:Q500000").Clear
                iQ1 = MinValue + Interval
                iQ2 = iQ1 + Interval
                iQ3 = iQ2 + Interval
                Debug.Print "Quartil 1: <= " & Format(iQ1, "000.000")
                Debug.Print "Quartil 2:  > " & Format(iQ1, "000.000") & ", <= " & Format(iQ2, "000.000")
                Debug.Print "Quartil 3:  > " & Format(iQ2, "000.000") & ", <= " & Format(iQ3, "000.000")
                Debug.Print "Quartil 4: => " & Format(iQ3, "000.000")
                
                Dim q1 As Range
                Dim q2 As Range
                Dim q3 As Range
                Dim q4 As Range
                Set q1 = .Range("J2")
                Set q2 = .Range("L2")
                Set q3 = .Range("N2")
                Set q4 = .Range("P2")
                
                Dim interestValues As Variant
                For Each interestValues In interestData
                    If (interestValues.Value <= iQ1) Then
                        AppendInterest q1, interestValues
                    ElseIf (interestValues.Value > iQ1) And (interestValues.Value <= iQ2) Then
                        AppendInterest q2, interestValues
                    ElseIf (interestValues.Value > iQ2) And (interestValues.Value <= iQ3) Then
                        AppendInterest q3, interestValues
                    Else    'interestValues > iQ3
                        AppendInterest q4, interestValues
                    End If
                Next interestValues
            End With
        End If
    Next ws
End Sub

Private Sub AppendInterest(ByRef quartil As Range, _
                           ByVal interest As Range)
    '--- copies the data in to the first empty row of the
    '    quartil group
    Dim lastRow As Long
    With quartil.Parent  'this is the worksheet
        lastRow = .Cells(.Rows.Count, quartil.Column).End(xlUp).Row
        quartil.Cells(lastRow, 1).Value = interest.Cells(1, 1).Value  'interest
        quartil.Cells(lastRow, 2).Value = interest.Cells(1, 2).Value  'qty
    End With
End Sub