simplifier une macro

[bpol]

bonjour,

j'ai en A3 une liste déroulante ( 1er trimestre, 2eme trimestre...)

j'ai également des feuilles avec ces noms et je voudrais que lorsque A3 correspond à une feuille elle enregistre les données sur cette feuille

au lieu de répéter la condition ce qui va allonger ma macro:

If Range("A3")= Sheets("1er trimestre")
then
Sheets("1er trimestre").Select
‘and
Ligne = Range("A65536").End(xlUp).Row + 1
Cells(Ligne, 1) = Sheets("encodage").Range("B5")
Cells(Ligne, 2) = Sheets("encodage").Range("B6")
Cells(Ligne, 3) = Sheets("encodage").Range("B7")
Cells(Ligne, 4) = Sheets("encodage").Range("B8")
Cells(Ligne, 5) = Sheets("encodage").Range("B9")
Cells(Ligne, 6) = Sheets("encodage").Range("B10")
Cells(Ligne, 7) = Sheets("encodage").Range("B11")
Cells(Ligne, 8) = Sheets("encodage").Range("B12")
Cells(Ligne, 9) = Sheets("encodage").Range("B13")
Cells(Ligne, 10) = Sheets("encodage").Range("B14")
Cells(Ligne, 11) = Sheets("encodage").Range("B15")
Cells(Ligne, 12) = Sheets("encodage").Range("B16")
Cells(Ligne, 13) = Sheets("encodage").Range("B17")
Cells(Ligne, 14) = Sheets("encodage").Range("B18")
Cells(Ligne, 15) = Sheets("encodage").Range("B19")
Cells(Ligne, 16) = Sheets("encodage").Range("B20")
Cells(Ligne, 17) = Sheets("encodage").Range("B21")
Cells(Ligne, 18) = Sheets("encodage").Range("B22")
Cells(Ligne, 19) = Sheets("encodage").Range("B23")
Cells(Ligne, 20) = Sheets("encodage").Range("B24")
Cells(Ligne, 21) = Sheets("encodage").Range("B25")
Cells(Ligne, 22) = Sheets("encodage").Range("B26")
Cells(Ligne, 23) = Sheets("encodage").Range("B27")
Cells(Ligne, 24) = Sheets("encodage").Range("B28")
Cells(Ligne, 25) = Sheets("encodage").Range("B29")
Cells(Ligne, 26) = Sheets("encodage").Range("B30")
Cells(Ligne, 27) = Sheets("encodage").Range("B31")
Cells(Ligne, 28) = Sheets("encodage").Range("B32")
Cells(Ligne, 29) = Sheets("encodage").Range("B33")
Cells(Ligne, 30) = Sheets("encodage").Range("B34")

End if




Sheets("encodage").Select
‘and
Range("B5:B8 ,B11 :B34").Select
Selection.ClearContents

‘and

ActiveWorkbook.Save

Merci

Bpol

 

[Robert]

Re : simplifier une macro

Bonjour Bpol, bonjour le forum,

Je te propose ta macro simplifiée :

Sub Macro1()
Dim ligne As Integer 'déclare la variable ligne
Dim x As Byte 'déclare la variable x
 
On Error GoTo fin 'gestion des erreurs : onglet ne correspondant pas (renvoi à l'étiquette "fin")
Sheets(Range("A3").Value).Select 'sélectionne l'onglet de la cellule A3
On Error GoTo 0 'annule la gestion des erreurs
ligne = Range("A65536").End(xlUp).Row + 1 'définit la variable ligne
For x = 1 To 30 'boucle sur 30 cellules
    Cells(ligne, x) = Sheets("encodage").Cells(x + 4, 2) 'récupère les valeurs de l'onglet "encodage"
Next x 'prochaine cellule de la boucle
Sheets("encodage").Range("B5:B8 ,B11:B34").ClearContents 'efface les données de la plage dans l'onglet "encodage"
ActiveWorkbook.Save 'sauve le classeur
Exit Sub 'sort de la procédure
 
fin: 'étiquette
MsgBox "Onglet non défini dans la cellule A3 !" 'message indiquant que la cellule A3 ne comporte pas de nom d'onglet existant
End Sub

 

[youky(BJ)]

Re : simplifier une macro

Bonjour bpol,
ceci à copier en événement Change de la feuille(A3)
En A3 est supposé un nom d'onglet, cette macro s'exécute dés le changement de A3

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
With Sheets([A3].Value)
If Err > 0 Then MsgBox "Onglet inexistant": Exit Sub
ligne = .Range("A65536").End(xlUp).Row + 1
For k = 1 To 30
.Cells(ligne, k) = Sheets("encodage").Range("B" & k + 4)
Next
End With
Sheets("encodage").Select
Range("B5:B8 ,B11 :B34").Select
Selection.ClearContents
'ActiveWorkbook.Save
End Sub

 

[Excel-lent]

Re : simplifier une macro

Bonsoir le fil,

Code de Youky(BJ) raccourci :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Sheets("encodage").select
With Sheets([A3].Value)
If Err > 0 Then MsgBox "Onglet inexistant": Exit Sub
ligne = .[A65536].End(xlUp).Row + 1
For k = 1 To 30
.Cells(ligne, k) = Range("B" & k + 4)
Next k
End With
Range("B5:B8,B11:B34").ClearContents
'ActiveWorkbook.Save
End Sub

Ce qui donne, après quelques rajout de seulement quelques saut de ligne et retraits, un aspect plus agréable à l'œil :

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Sheets("encodage").select

With Sheets([A3].Value)
   If Err > 0 Then MsgBox "Onglet inexistant": Exit Sub
   ligne = .[A65536].End(xlUp).Row + 1

   For k = 1 To 30
       .Cells(ligne, k) = Range("B" & k + 4)
   Next k
End With

Range("B5:B8,B11:B34").ClearContents
'ActiveWorkbook.Save

End Sub

Bonne soirée

Edition : Bonjour à toi aussi Nolich, XLDnaute pas si occasionnel que ça 🙂

 

[nolich]

Re : simplifier une macro

Bonsoir Robert le fameux, youki(BJ) le Caluirard et l'Excel-lent Accro pas si lent 🙂
Bonsoir à toutes et à tous 🙂

Une autre solution. Comme quoi il existe des myriades (j'exagère à peine) de façon de procéder 😉

[COLOR="Blue"]Sub[/COLOR] Copier()

[COLOR="Green"]'-----------------------------------------------[/COLOR]
[COLOR="blue"]Dim[/COLOR] [B]ShEncodage[/B] [COLOR="blue"]As[/COLOR] Worksheet, [B]ShTrim[/B] [COLOR="blue"]As[/COLOR] Worksheet
[COLOR="green"]'-----------------------------------------------[/COLOR]
[COLOR="blue"]Dim[/COLOR] [B]Tablo[/B]
[COLOR="green"]'-----------------------------------------------[/COLOR]
[COLOR="blue"]Dim[/COLOR] [B]Ligne[/B] [COLOR="blue"]As Long[/COLOR]
[COLOR="green"]'-----------------------------------------------
'
  ' Définition de l'objet ShEncodage[/COLOR]
  [B]ShEncodage[/B] = Sheets("Encodage")
  
  [COLOR="green"]' Si la cellule A3 de la feuille Encodage est
  ' différente de vide, c'est qu'elle contient une
  ' des 4 valeurs : "1er trimestre;2ème trimestre;
  ' 3ème trimestre;4ème trimestre"[/COLOR]
  
  [COLOR="blue"]If[/COLOR] Range("A3") <> "" [COLOR="blue"]Then[/COLOR]
    
    [COLOR="blue"]Set[/COLOR] [B]ShTrim[/B] = Sheets(Range("A3"))
    
    [B]Ligne[/B] = [B]ShTrim[/B].Range("A65536").End(xlUp).Row + 1
    
    [B]Tablo[/B] = [B]ShEncodage[/B].Range("B5:B34")
    
    ShTrim.Range("A" & Ligne & ":" & "AD" & Ligne) = Tablo
    
    [B]ShEncodage[/B].Range("B5:B8 ,B11 :B34").ClearContents
    
    ActiveWorkbook.Save
    
  [COLOR="blue"]End If[/COLOR]
  
[COLOR="blue"]End Sub[/COLOR]

@+

 

[bpol]

Re : simplifier une macro

bonsoir Robert, Youky(bj), nolich,

que de solutions que choisir?

cela pourrait être une nouvelle question sur ce post loll.....


MERCI à tout


Bpol

 

[nolich]

Re : simplifier une macro

Re 🙂

que de solutions que choisir?

Si j'étais vaniteux, je te dirais la mienne 😀 mais comme je suis XLDien, peu importe laquelle tu choisis. Le principal étant que tu aies une solution 😉

Au plaisir...

@+

 

[youky(BJ)]

Re : simplifier une macro

Bonjour le forum,
On n'a pas utilisé la méthode "Transpose"
Voila qui est fait en me basant sur la belle macro de Nolich.

Sub Copier()
Dim Ligne As Long
  If Range("A3") <> "" Then
    Ligne = Sheets([A3].Value).Range("A65536").End(xlUp).Row + 1
    Sheets([A3].Value).Range("A" & Ligne & ":" & "AD" & Ligne).Value = _
    Application.Transpose([encodage!B5:B34].Value)
    Sheets("encodage").Range("B5:B8 ,B11 :B34").ClearContents
    
    ActiveWorkbook.Save
    
  End If
End Sub

 

[nolich]

Re : simplifier une macro

Re et bonjour youki 🙂

Bonjour le forum,
On n'a pas utilisé la méthode "Transpose"
Voila qui est fait en me basant sur la belle macro de Nolich.

Sub Copier()
Dim Ligne As Long
  If Range("A3") <> "" Then
    Ligne = Sheets([A3].Value).Range("A65536").End(xlUp).Row + 1
    Sheets([A3].Value).Range("A" & Ligne & ":" & "AD" & Ligne).Value = _
    Application.Transpose([encodage!B5:B34].Value)
    Sheets("encodage").Range("B5:B8 ,B11 :B34").ClearContents
    
    ActiveWorkbook.Save
    
  End If
End Sub

Merci pour le compliment mais sans ton idée de Transpose, ma macro ne fonctionne pas alors que la tienne est parfaite : claire et concise 😉

@+

 

[vbacrumble]

Re : simplifier une macro

Bonjour à tous


Pour le fun (et pour me dégourdir les doigts 😀 )

Sub CopierV3()
Dim Ligne&, w As Workbook, s As Worksheet: Set w = ThisWorkbook: Set s = Sheets("encodage")
With w
    With .ActiveSheet
        Ligne = IIf((Not IsEmpty(.[A3])), Sheets(CStr([A3])).[A65536].End(xlUp).Row + 1, 1)
        Sheets(CStr([A3])).Range("A" & Ligne & ":AD" & Ligne) = Application.Transpose(s.[B5:B34])
    End With
    s.[B5:B8 ,B11:B34] = ""
.Save
End With
End Sub