Combining two VBA

[pete4monc]

Hi all

I am new to vba and need some help. I have copied, modified and tried multiple vba to do the below but can't seem to get one to do all that I need.
I have one workbook with 10 worksheets in. I need my vba to look in all sheets in column L.
If there is a value greater then 3, copy the corresponding cell in column B to sheet 1 but inserting the sheet name in Column A first.
Then check all sheets.

please see my code below, any help will be greatly appreciated.

Sub filldata()

Sheets("Sheet1").Select
Range("A1:A20").Select
Selection.ClearContents
Range("A1").Select

LastRow = Sheet2.Range("L20").End(xlUp).Row
i = 2
j = 1

For i = 2 To LastRow

If Sheet2.Range("H" & i).Value <> 0 Then 'the condition to check

Sheet1.Range("B" & j).Value = Sheet2.Range("A" & i).Value

j = j + 1

End If


Next


End Sub

 

[Fluff]

How about

Sub pete4monc()
   Dim Ws As Worksheet
   Dim Ary As Variant, Rws As Variant
   
   For Each Ws In Worksheets
         If Ws.Name <> "Sheet1" Then
         With Ws.Range("B2:B" & Ws.Range("L" & Rows.Count).End(xlUp).Row)
            Rws = Filter(Ws.Evaluate(Replace("transpose(if(@>3,row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
            If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
         End With
         If UBound(Rws) >= 0 Then
            With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
               .Resize(UBound(Ary)).Value = Ws.Name
               .Offset(, 1).Resize(UBound(Ary)).Value = Ary
            End With
         End If
      End If
   Next Ws
End Sub

 

[pete4monc]

How about

Sub pete4monc()
   Dim Ws As Worksheet
   Dim Ary As Variant, Rws As Variant
 
   For Each Ws In Worksheets
         If Ws.Name <> "Sheet1" Then
         With Ws.Range("B2:B" & Ws.Range("L" & Rows.Count).End(xlUp).Row)
            Rws = Filter(Ws.Evaluate(Replace("transpose(if(@>3,row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
            If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
         End With
         If UBound(Rws) >= 0 Then
            With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
               .Resize(UBound(Ary)).Value = Ws.Name
               .Offset(, 1).Resize(UBound(Ary)).Value = Ary
            End With
         End If
      End If
   Next Ws
End Sub

Hi Fluff

That worked brilliant.
I have added a little bit of my code to remove all contents on sheet 1, before running yours and it all works.
Which is nothing for you gurus but for a learner like me it's brilliant.....lol
Sorry, I forgot to mention there are some sheets in the workbook that have graphs and reports that I do not want the vba to run on.
If I only wanted to run the code on certain sheets is it possible ie: only on sheet 4, sheet 6 and sheet 8 and none of the others?
How could I add this to your code to run on only these sheets? example
Sheets("Sheet2, Sheet4, Sheet6" etc etc).Select

Thanks for your help.
Pete

Sub pete4monc()
Dim Ws As Worksheet
Dim Ary As Variant, Rws As Variant

Sheets("Sheet1").Select
Range("A1:B20").Select
Selection.ClearContents


For Each Ws In Worksheets
If Ws.Name <> "Sheet1" Then
With Ws.Range("B2:B" & Ws.Range("L" & Rows.count).End(xlUp).Row)
Rws = Filter(Ws.Evaluate(Replace("transpose(if(@>3,row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
End With
If UBound(Rws) >= 0 Then
With Sheets("Sheet1").Range("A" & Rows.count).End(xlUp).Offset(1)
.Resize(UBound(Ary)).Value = Ws.Name
.Offset(, 1).Resize(UBound(Ary)).Value = Ary
End With
End If
End If
Next Ws
End Sub

 

[Fluff]

How many sheet should it not look at & how many should it look at?

 

[pete4monc]

How many sheet should it not look at & how many should it look at?

Hi Fluff

Must not look at 7 sheets that are made up of data, reports and graphs and must look into 17 other sheets.
I this what you mean?

 

[Fluff]

Ok, how about like

Sub pete4monc()
   Dim ws As Worksheet
   Dim Ary As Variant, Rws As Variant
   
   For Each ws In Worksheets
      Select Case ws.Name
         Case "Sheet2", "Sheet3", "Sheet7"      'sheets that should be ignored
         Case Else
            With ws.Range("B2:B" & ws.Range("L" & Rows.Count).End(xlUp).Row)
               Rws = Filter(ws.Evaluate(Replace("transpose(if(@>3,row(@)-min(row(@))+1,false))", "@", .Offset(, 10).Address)), False, False)
               If UBound(Rws) >= 0 Then Ary = Application.Index(.Value, Application.Transpose(Rws), 1)
            End With
            If UBound(Rws) >= 0 Then
               With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
                  .Resize(UBound(Ary)).Value = ws.Name
                  .Offset(, 1).Resize(UBound(Ary)).Value = Ary
               End With
            End If
      End Select
   Next ws
End Sub

 

[pete4monc]

Hi Fluff

I have put in all the sheet names but for some reason it is coping all values in column B (from all the other sheets) and pasting them into sheet1 not just the ones where the value in column L is greater then 3?

 

[Fluff]

Did the original code I posted work?

 

[pete4monc]

Hi Fluff

Yes the original vba I setup with a small workbook with dummy data and it worked perfect.

 

[Fluff]

In that case did you test the 2nd code in the same workbook?