Microsoft 365 Ajouter une nouvelle et écrire dans la feuille

[VBA_dev_Anne_Marie]

Bonjour,

Je voudrais ajouter une nouvelle feuille, dont le nom sera la valeur de Cells(2, 1) de la feuille Coûts.
Ensuite, je voudrais remplir la nouvelle feuille ajoutée, mais mon code With Sheets("& Cells(2, 1).Value &") ne marche pas.

  Sheets.Add.Name = Sheets("Coûts").Cells(2, 1)
    
     With Sheets("& Cells(2, 1).Value &")
    
     .Cells(1, 2) = "Numéro"
     .Cells(1, 3) = Sheets("Coûts ").Cells(2, 1)
    
     End With

Merci pour votre aide.

 

[dysorthographie]

bonjour,

     With Sheets.Add
        .Name = Sheets("Coûts").Cells(2, 1)
         .Cells(1, 2) = "Numéro"
         .Cells(1, 3) = Sheets("Coûts").Cells(2, 1)
     End With

 

[sousou]

Bonjour
essaie comme ceci
Sheets(Cells(2, 1).Value)

 

[Laurent78]

Bonjour,
pas bien compris l'objectif, code à essayer :

Sub test()
Sheets.Add.Name = Sheets("Coûts").Cells(2, 1)
  
     With Sheets(Sheets("Coûts").Cells(2, 1).Value)
  
     .Cells(1, 2) = "Numéro"
     .Cells(1, 3) = Sheets("Coûts").Cells(2, 1)
  
     End With

End Sub

Cdlt

PS : je viens de vois le post #2 de dysorthographie, le code est mieux que le mien

 

[VBA_dev_Anne_Marie]

bonjour,

     With Sheets.Add
        .Name = Sheets("Coûts").Cells(2, 1)
         .Cells(1, 2) = "Numéro"
         .Cells(1, 3) = Sheets("Coûts").Cells(2, 1)
     End With

Merci, mais je n'arrive pas à appliquer le code en mode Macro, pour créer autant da fichier que des lignes dans la colonne A : le Next i ne marche pas, je me retrouve avec les mêmes données dans toutes les feuilles.

Sub AddSheets()
'Updateby Extendoffice
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = Worksheets("Coûts")
    Set wBk = ActiveWorkbook
    Dim i As Long
    Application.ScreenUpdating = False
    Dim DernLigneContratCout As Long
    
    With Worksheets("Coûts")
        
    DernLigneContratCout = .Range("A" & .Rows.Count).End(xlUp).Row
    
    
    For Each xRg In wSh.Range("A2: A" & DernLigneContratCout)
    For i = 2 To DernLigne
    
        With wBk
        
        
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            
            'on nomme le fichier avec les données dans la colonne A
            ActiveSheet.Name = xRg.Value
            
          With ActiveSheet
          
           'on alimente le même fichier avec les données dans la colonne A
         .Cells(1, 2) = "Numéro"
         .Cells(1, 3) = Sheets("Coûts").Cells(i, 1)
    
         Next i
      End With
            
            
            
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " erreur "
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
    End With
End Sub

 

[dysorthographie]

pour créer autant de fichier 'c'est bien une première!

Fichier? Onglets et/ou Classeurs???

Sub test()
Dim I As Integer, R As Range
Set R = Sheets("Coûts").Range("A1").CurrentRegion
For I = 2 To R.Rows.Count
    If Not OngletExiste(R(I, 1)) Then
        With Sheets.Add
           .Name = R(I, 1)
            .Cells(1, 2) = "Numéro"
            .Cells(1, 3) = R(I, 1)
        End With
     End If
Next
End Sub
Function OngletExiste(S As String) As Boolean
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Sheets
    OngletExiste= UCase(Sh.Name) = UCase(S)
    If OngletExisteThen Exit Function
Next
End Function

 

[VBA_dev_Anne_Marie]

Fichier? Onglets et/ou Classeurs???

Sub test()
Dim I As Integer, R As Range
Set R = Sheets("Coûts").Range("A1").CurrentRegion
For I = 2 To R.Rows.Count
    If Not OngletExiste(R(I, 1)) Then
        With Sheets.Add
           .Name = R(I, 1)
            .Cells(1, 2) = "Numéro"
            .Cells(1, 3) = R(I, 1)
        End With
     End If
Next
End Sub
Function OngletExiste(S As String) As Boolean
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Sheets
    OngletExiste= UCase(Sh.Name) = UCase(S)
    If OngletExisteThen Exit Function
Next
End Function

Ici, on contrôle, si la feuille existe déjà, n'est-ce pas ?

Merci !

 

[dysorthographie]

If Not OngletExiste(R(I, 1)) Then
c'est exeacte

 

[VBA_dev_Anne_Marie]

If Not OngletExiste(R(I, 1)) Then
c'est exeacte

Merci !