If Column B contains Yes Copy Adjacent cell in column A and C and Paste to J and K with a VBA

[Demer]

Hello I have multiple sheets in a workbook (30 + Sheets) Plus more added randomly as project grows. On every sheet I need to automatically copy column A range A3: A500 and Column C's range :C3:C500 Data based on cell value "Yes" from Column B and Paste all of them to a sheet called Approved_Requests in Column A & B from a button. Im having trouble crawling all the sheets with the code I have it collect data from some of the sheets at once. However, it doesn't do it for all of them it skips some which I don't understand why. I have searched several places on the internet but cant figure it out. I was originally trying to copy those column cell values from A & C and pasting it to J& K on every sheet then to the Approved_Request" sheet with this code but I actually need them to go straight to the sheet "Approved_Request" Here is what I have so far running two different macros Any help would be greatly appreciated if this could be combined to one and crawl all the sheets instead of skipping some.

Sub Mod1()
Application.ScreenUpdating = False
Dim Rng As Range
For Each Rng In Range("B3:B2500")
Select Case Rng.Value
Case "Yes"
Cells(Rng.Row, 10).Value = Cells(Rng.Row, 1).Value

End Select
Next Rng
Application.ScreenUpdating = True
End Sub

Sub Approved()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim Row As Long
Dim Bow1 As Long
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Approved_Request"")
Sheets("Approved_Request"").Activate
Cells.Clear
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Approved_Request""
Row = shArc.Range("B" & Rows.Count).End(xlUp).Row + 1
sh.Range("J3:J50000").Copy
shArc.Range("B" & Row).PasteSpecial

Bow1 = shArc.Range("B" & Rows.Count).End(xlUp).Row + 1
sh.Range("K3:K50000").Copy
shArc.Range("C" & Row).PasteSpecial
End Select
Next
Application.CutCopyMode = False
Set shArc = Nothing
Set sh = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

Why 500 in this "A3: A500" and this "C3:C500"?
And why 2500 in this "Range("B3:B2500")"?
Are that numbers to ensure that the range is big enough?
Will having a last used cell address be OK?

To make your code more readable, have a peek at this picture.

 

[Demer]

The range for all of them can be the last used cell. Those ranges you see were just test I was trying.

 

[jolivanes]

Sub Is_This_What_You_Mean()
Dim c As Range, sh As Worksheet, shAR As Worksheet
Application.ScreenUpdating = False
Set shAR = Worksheets("Approved_Request")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "Approved_Request" Then
            For Each c In sh.Range("B2:B" & sh.Cells(Rows.Count, 2).End(xlUp).Row)
                If c.Value = "Yes" Then
                    shAR.Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = c.Offset(, -1).Value
                    shAR.Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = c.Offset(, 1).Value
                End If
            Next c
        End If
    Next sh
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

AutoFilter should be faster although it still loops through the sheets.
In your first post, you have a reference of "B3:B2500". You might need to change the references in this code to reflect that.

Sub With_AutoFilter()
Dim sh As Worksheet, lr As Long
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Approved_Request" Then
    With sh
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        .AutoFilterMode = False
            With .Range("A1:C" & lr)
                .AutoFilter 2, "Yes"
                    .Columns(2).Hidden = True
                        .Range("A2:C" & lr).SpecialCells(12).Copy Sheets("Approved_Request").Cells(Rows.Count, 1).End(xlUp).Offset(1)
                    .Columns(2).Hidden = False
                .AutoFilter
            End With
    End With
End If
Next sh
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

Any of this of any use?