Microsoft 365 Feuille de route Tournoi

Sub SynthPoule()
Dim WsFdr As Worksheet
Dim FeuilleSynth As Worksheet
Dim Poule As Range


For Each WsFdr In ActiveWorkbook.Sheets
    If WsFdr.Name Like "fdr *" Then
        With WsFdr
            If Not FeuilleExiste(CStr(.Range("A1"))) Then
                Sheets.Add after:=Sheets(Sheets.Count)
                ActiveSheet.Name = .Range("A1")
            End If
            Set FeuilleSynth = Sheets(CStr(.Range("A1")))
            Set Poule = .Range("A1:C11")
        End With
       
        With FeuilleSynth
            LastLine = .UsedRange.Rows.Count + 1
            'LastCol = .UsedRange.Columns.Count
            Poule.Copy Destination:=.Cells(LastLine, 1)
        End With
    End If
Next WsFdr
End Sub


Function FeuilleExiste(NomFeuille As String) As Boolean
    FeuilleExiste = False
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name = NomFeuille Then
            FeuilleExiste = True
            Exit Function
        End If
    Next ws
End Function

Sub SynthPoule()
Dim WsFdr As Worksheet
Dim FeuilleSynth As Worksheet
Dim Poule As Range
Const NbEnLigne = 3 'nb de tableaux de poule a mettre cote à cote

Application.ScreenUpdating = False
For Each WsFdr In ActiveWorkbook.Sheets
    If WsFdr.Name Like "fdr *" Then
        With WsFdr
            If Not FeuilleExiste(CStr(.Range("A1"))) Then
                Sheets.Add after:=Sheets(Sheets.Count)
                ActiveSheet.Name = .Range("A1")
            End If
            Set FeuilleSynth = Sheets(CStr(.Range("A1")))
            Set Poule = .Range("A1:C11")
        End With
        
        With FeuilleSynth
            If .UsedRange.Rows.Count = 1 Then
                Lastline = 1
                LastCol = 1
            Else
                Lastline = .Range("A" & .Rows.Count).End(xlUp).Row - 9
                LastCol = .Cells(Lastline, .Columns.Count).End(xlToLeft).Column + 3
                If LastCol = NbEnLigne * 4 + 1 Then
                    LastCol = 1
                    Lastline = Lastline + 12
                End If
            End If
            Poule.Copy Destination:=.Cells(Lastline, LastCol)
        End With
    End If
Next WsFdr
Application.ScreenUpdating = True
End Sub


Function FeuilleExiste(NomFeuille As String) As Boolean
    FeuilleExiste = False
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name = NomFeuille Then
            FeuilleExiste = True
            Exit Function
        End If
    Next ws
End Function