Option Explicit
Sub annexe()
Dim ShtA As Worksheet
Dim ShtBlh As Worksheet
Dim derLig As Long
Dim f As String
Dim n As Integer
Dim trouve As Boolean
Set ShtA = Sheets("Annexe 1")
Set ShtBlh = Sheets("Bilan hebdo")
derLig = ShtBlh.Range("A" & Rows.Count).End(xlUp).Row
ShtA.[B6].Value = ShtBlh.Range("A" & derLig).Value
ShtA.[B23].Value = ShtBlh.Range("B" & derLig).Value
ShtA.[G14].Value = ShtBlh.Range("C" & derLig).Value
ShtA.[G15].Value = ShtBlh.Range("D" & derLig).Value
ShtA.[G16].Value = ShtBlh.Range("E" & derLig).Value
ShtA.[G17].Value = ShtBlh.Range("F" & derLig).Value
ShtA.[G18].Value = ShtBlh.Range("G" & derLig).Value
ShtA.[A26].Value = ShtBlh.Range("H" & derLig).Value
ShtA.[B26].Value = ShtBlh.Range("I" & derLig).Value
ShtA.[C26].Value = ShtBlh.Range("J" & derLig).Value
ShtA.[D26].Value = ShtBlh.Range("K" & derLig).Value
f = ShtA.[B6].Value
For n = 1 To Sheets.Count
If Sheets(n).Name = f Then
trouve = True
Exit For
End If
Next n
If trouve Then Exit Sub
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = f
ThisWorkbook.Worksheets("Annexe 1").Cells.Copy ThisWorkbook.Worksheets(f).Cells
Set ShtA = Nothing
Set ShtBlh = Nothing
End Sub