Run-time Error 1004, No cells were found

[RemcoVBA]

Dear all,

I'm the match secretary of our local football club. Each weekend I need to provide an overview of all matches to be played that weekend, showing which field, what time, etc.
I've build an excel sheet to generate this overview from an export from the special software we use to plan the matches.

My knowledge of VBA is quite limited but by browsing on forums, recording macros and looking at the code and some common sense I managed to build a script that does exactly what I want.


I'm using the autofilter function to identify all matches to be played on Friday, Saturday and Sunday.
For each day I copy / paste all the matches to a seperate section on another sheet.

Everything works fine until there's no match to be played on one of the days mentioned above.
A message 'Run-time Error 1004, No cells were found' pops up and the script will stop.
I've been looking for solutions a couple of hours, but nothing seems to work.

Can anyone guide me into the right direction?
Basiscally what I want the script to do is when it doesn't find matches for friday it should continue to run and trying to find matches for saturday.

Thanks
Remco


Below is (part of) my script:

'Autofilter Home matches saturday

ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="saturday"



'Copy visible cells

Dim rSource As Range
Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)

rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy

'Paste to sheet Home matches
Sheets("Home matches").Select
Range("A11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
       
'Autofilter Home matches friday

Sheets("Voorbereiding").Select
ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="friday"



'Copy visible cells

Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)
rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy

'Paste to sheet Home matches
Sheets("Home matches").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   
'Autofilter Home matches Sunday

Sheets("Voorbereiding").Select
ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="sunday"


'Copy visible cells

Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)
rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy

'Paste to sheet Home Matches
Sheets("Home Matches").Select
Range("A39").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 

[Fluff]

You can replace all that code with

Sub RemcoVBA()
   Dim Ary As Variant
   Dim i As Long
   Dim Ws As Worksheet
   
   Set Ws = Sheets("Home matches")
   Ary = Array("saturday", "A11", "friday", "A6", "sunday", "A39")
   
   For i = 0 To UBound(Ary) Step 2
      With Sheets("Voorbereiding")
         .Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
         .Range("A:Q").AutoFilter Field:=16, Criteria1:=Ary(i)
         .AutoFilter.Range.Offset(1).Resize(, 13).Copy
         Ws.Range(Ary(i + 1)).PasteSpecial xlPasteValues
      End With
   Next i
End Sub

 

[Peter_SSs]

One way is testing for filter results before trying to copy. Like this.
You'd need to do that for each section.

'Autofilter Home matches saturday

ActiveSheet.Range("A:Q").AutoFilter Field:=17, Criteria1:="home"
ActiveSheet.Range("A:Q").AutoFilter Field:=16, Criteria1:="saturday"

'Copy visible cells
If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlVisible).Count > 1 Then
  Dim rSource As Range
  Set rSource = Range("A1").CurrentRegion.Offset(1).Resize(, 13)
  
  rSource.Resize(rSource.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
  
  'Paste to sheet Home matches
  Sheets("Home matches").Select
  Range("A11").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
       
End If

 

[RemcoVBA]

Wow, you guys are true heros! It solved my problem and my script is running flawless! And you guys provided me the answers only a few minutes after my post!
Thank you so much!

ps: apologies for not tagging my question. Will sure do next time.

 

[Fluff]

Glad we could help & thanks for the feedback.