Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Amélioration de code

M

M@xu3L

XLDnaute Junior
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 :

VB: 
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 :
Code: 
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
 
Solution
M
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 ^^
VB: 
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")...
Trier par date Trier par votes
M

M@xu3L

XLDnaute Junior
BrunoM45 à dit:
Bonsoir,

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

A+
Cliquez pour agrandir...
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 ^^
 
Vote positif 0 Vote négatif
M

M@xu3L

XLDnaute Junior
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 ^^
VB: 
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 ^^
 
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
935
Nicolas JACQUIN
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
269
Latias
L
I
  • Question
XL 2016 Modification d'une ligne dans mon code
Réponses
2
Affichages
559
INFINITY100
I
I
  • Question
XL 2016 Mon code VBA me renvoi une erreur
Réponses
6
Affichages
677
INFINITY100
I
S
  • Question
XL 2019 fonctions COUNTIF and COUNTIFS sur une plage de données filtrée en vba
Réponses
2
Affichages
1 K
Hasco
  • Résolu(e)
XL 2016 Problèmes de Range, tentative de boucle entre 2 fichiers
Réponses
4
Affichages
690
R3n0W
M
  • Question
Microsoft 365 Copier les données d'une feuille à une autre
Réponses
6
Affichages
1 K
mimich_88
M
K
  • Résolu(e)
XL 2019 Copier Seulement les lignes affichée après un filtre de tableau
Réponses
9
Affichages
1 K
Kushi
K
R
  • Résolu(e)
XL 2016 Un petit coup de main pour un code VBA
Réponses
11
Affichages
751
ReneDav14000
R
M
  • Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
426
Mika07
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…