XL 2016 Amélioration de code

[M@xu3L]

Bonjour tous le monde,

Je viens vous embêter parce que je ne comprend pas vraiment pourquoi sa ne fonctionne pas comme je le souhaite mais a mon avis c'est tous bête...

Voici le code que j'ai à la base :

Private Sub CommandButton1_Click()
    Dim lngLastR As Long
    Dim strName As String
    
    lngLastR = Cells(Rows.Count, "h").End(xlUp).Row
    strName = Range("h7").Value
    ' Si oublie de renseigner le nom
    If strName = "" Then strName = Environ("username")
    Range("g12:k" & lngLastR).Copy
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = strName
    Worksheets(strName).Range("e3").Value = Format(Now, "MM/DD/YYYY HH:MM")
    Worksheets(strName).Range("d5").PasteSpecial
    Application.CutCopyMode = False
    Worksheets(strName).Columns("E:E").ColumnWidth = 47
    Worksheets(strName).Range("F5:H6").Select
    With Selection
    Selection.RowHeight = 39
    Selection.ColumnWidth = 6
    End With
    With Sheets(strName).Range("e3")
    .HorizontalAlignment = xlCenter
        With .Font
        .Bold = True
        .Size = 15
        End With
    End With
    Worksheets("Résultats").Range("h7").Value = Empty
    Worksheets("Résultats").Range("j7").Value = Empty
    Worksheets("Résultats").Range("h12:k" & lngLastR).Value = Empty
Worksheets("Résultats").Activate
ActiveWorkbook.Save

    
End Sub

Et je voulais le modifier, car le problème est que plusieurs personnes peuvent aller sur ce fichier en même temps et donc lorsque qu'il vont cliquer sur mon bouton sa enregistre un nouveau fichier et pas forcement un onglet comme je le souhaitais. Donc mon idée (peut être que ce n'est pas la bonne ^^) était de créer un fichier d'accueil de mes onglets qui allait être créé.
Donc je voulais modifier mon code comme ceci :

Private Sub CommandButton1_Click()
    Dim lngLastR As Long
    Dim strName As String

    lngLastR = Cells(Rows.Count, "h").End(xlUp).Row
    strName = Range("h7").Value
    ' Si oublie de renseigner le nom
    If strName = "" Then strName = Environ("username")
    Range("g12:k" & lngLastR).Copy
    classeurActif = ActiveWorkbook.Name
    classeurCible = "Classeur fermé.xlsx"
    Workbooks.Open Filename:=ActiveWorkbook.Path &  "\" & classeurCible
    Windows(classeurActif).Activate
     ActiveSheet.Copy after:=Workbooks(classeurCible).Sheets(Workbooks(classeurCible).Sheets.Count) .Name=strName
      Worksheets(strName).Range("e3").Value = Format(Now, "MM/DD/YYYY HH:MM")
    Worksheets(strName).Range("d5").PasteSpecial
    Application.CutCopyMode = False
    Worksheets(strName).Columns("E:E").ColumnWidth = 47
    Worksheets(strName).Range("F5:H6").Select
    With Selection
    Selection.RowHeight = 39
    Selection.ColumnWidth = 6
    End With
    With Sheets(strName).Range("e3")
    .HorizontalAlignment = xlCenter
        With .Font
        .Bold = True
        .Size = 15
        End With
    End With
    Worksheets("Résultats").Range("h7").Value = Empty
    Worksheets("Résultats").Range("j7").Value = Empty
    Worksheets("Résultats").Range("h12:k" & lngLastR).Value = Empty
Workbooks(classeurCible).Close True
Worksheets("Résultats").Activate
ActiveWorkbook.Save


End Sub

Mais voila sa ne fonctionne pas et je ne sais pas pourquoi... HELP me plz...

Merci d'avance de vos lumières

 

[Compte Supprimé 979]

Bonsoir,

Il serait bien d'expliquer clairement la situation et ce que vous voulez faire exactement

A+

 

[M@xu3L]

Bonsoir,

Il serait bien d'expliquer clairement la situation et ce que vous voulez faire exactement

A+

Ah oui c'est vrai pardon tellement prit dedans que j'en ai oublié l'essentiel...

En faite à la base ce code était fait pour me créer un onglet avec la copie des réponse donner dans un tableau avec le nom en titre d'onglet...
Maintenant le problème est que plusieurs personnes vont aller sur ce tableau pour répondre en même temps... Donc l'idée était de créer un autre tableau indépendant qui ne serai ouvert que lorsque l'on clic sur le bouton et qui va créer un onglet dans ce tableau indépendant je sais pas si c'est bien expliqué ou clair tous sa lol ^^

 

[M@xu3L]

Bon bah du coup j'ai réussi à trouver comment faire ce que je voulais ^^
Je vous met le code que j'ai réaliser (pas tous seul ^^) et du coup sa me copie mon tableau dans un autre classeur en ajoutant un nouvelle onglet ^^

Private Sub CommandButton1_Click()
    Dim lngLastR As Long
    Dim strName As String
    
    lngLastR = Cells(Rows.Count, "h").End(xlUp).Row
    strName = Range("h7").Value
    ' Si oublie de renseigner le nom
    If strName = "" Then strName = Environ("username")
    Range("g12:k" & lngLastR).Copy
    Workbooks.Open (ThisWorkbook.Path & "\Test.xlsm")
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = strName
    Worksheets(strName).Range("e3").Value = Format(Now, "MM/DD/YYYY HH:MM")
    Worksheets(strName).Range("d5").PasteSpecial
    Application.CutCopyMode = False
    Worksheets(strName).Columns("E:E").ColumnWidth = 47
    Worksheets(strName).Range("F5:H6").Select
    With Selection
    Selection.RowHeight = 39
    Selection.ColumnWidth = 6
    End With
    With Sheets(strName).Range("e3")
    .HorizontalAlignment = xlCenter
        With .Font
        .Bold = True
        .Size = 15
        End With
    End With
    Workbooks("2sur5.xlsm").Activate
    Worksheets("Résultats").Range("h7").Value = Empty
    Worksheets("Résultats").Range("j7").Value = Empty
    Worksheets("Résultats").Range("h12:k" & lngLastR).Value = Empty
Worksheets("Résultats").Activate
ActiveWorkbook.Save
Workbooks("Test.xlsm").Close SaveChanges:=True
Application.Quit
    
End Sub

Merci quand même à ceux qui on lu et on voulu m'aider ^^