Choix onglet spécifique pour copier coller

VBA
1

Bonjour,

J’ai cherché , cherché, et pas moyen de trouver ce qui me correspond, je sais faire les macros en manipulant avec la souris mais je ne connais rien en code VBA donc pour créer cette macro ca reste compliqué pour moi.

Ci joint le tableau d’essai

J’aimerai en cliquant sur le bouton valider, que la macro copie les données des cellules B1,B3,B4,B5,B6 pour aller ensuite les coller après insertion en ligne 2 dans la feuille correspondant à celle sélectionnée en cellule

B2 (alpha,bravo,charlie ou delta) ainsi que dans la feuille “tableau général”

J’aimerai que ces données copiées soient collées en ligne 2 du tableau général ainsi que celui sélectionné en B2 et que les bordures des lignes insérées soient appliquées. J’ai besoin que ces lignes insérées soient toujours en ligne 2 pour avoir les dernières entrées en haut du tableau.

Et pour finir la macro revient effacer toutes les données entrées en colonne B et rester sur cette feuille “menu”

J’espère avoir était clair et précis (pas facile)

Merci d’avance pour votre aide.

2

Nouveau Feuille de calcul Microsoft Excel.xlsx (14,2 Ko)

3

Bonjour

Ca me semble parfaitement réalisable avec l’enregistreur de macros ( donc sans regarder le code VBA).

Qu’est-ce qui te bloque exactement? Quelle erreur obtiens-tu?

A bientôt

4

Bonjour @AlainPncl, @DocteurExcel,

@AlainPncl, puisque tu as déjà des connaissances en macro VBA, je ne rentrerais pas dans les détails.

Donc voici une proposition, qui n’ai pas parfaite, mais elle a le mérite de fonctionner comme tu le demandes.

Après avoir entré les données dans la feuille « Menu » en « B1:B6 » cliquer sur le bouton « Valider ».
Les données « B1, B3:B6 » sont réparties dans la feuille sélectionnée en « B2 » et sont aussi copiées dans la feuille « Tableau général » les unes au dessus des autres ( c’est à dire en ligne 2).

Comme nous insérons une ligne, le format de couleur de la ligne 1 suit, donc j’ai du ruser pour effacer le format copié et j’ai ajouté un code dans chaque feuilles « Tableau général, Alpha, Bravo, Charlie, Delta » pour remettre un encadrement cellule non vide.

Enfin on efface les données de la feuille « Menu ».

Code VBA des feuilles:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

  Set Target = Intersect(Target, [A2:A5000])
  If Target Is Nothing Then Exit Sub
  On Error Resume Next
  Intersect(Target.SpecialCells(xlCellTypeBlanks).EntireRow, [A2:E5000]).Borders.LineStyle = xlNone
  Intersect(Target.SpecialCells(xlCellTypeConstants).EntireRow, [A2:E5000]).Borders.Weight = xlThin
 
End Sub

Code VBA du bouton « Valider »:

Sub Copie()
 
Derligne = 2
 
Application.ScreenUpdating = False
Application.EnableEvents = False
                
    With Sheets(Range("B2").Value)
        .Rows(Derligne).Insert
            
        Sheets("Menu").Range("B1,B3:B6").Copy
            .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            .Range("A2:E5000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlNo
    
    End With
    
    With Sheets("Tableau général")
       .Rows(Derligne).Insert
            
        Sheets("Menu").Range("B1,B3:B6").Copy
            .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            
    End With
    
    Sheets(Array("Tableau général", "Alpha", "Bravo", "Charlie", "Delta")).Select
    Sheets("Tableau général").Activate
    Rows("2:5000").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A2").Select
    Sheets("Menu").Select
    Worksheets("Menu").Range("B1:B6").ClearContents
    
Application.EnableEvents = True

ActiveWorkbook.Save

End Sub

Pour les feuilles « Alpha, Bravo, Charlie, Delta » je supprime les doublons, ce que je ne fais pas pour la feuille « Tableau général »

ActiveWorkbook.Save

Enfin cette ligne de code, sauvegarde le fichier à la fin de l’exécution de la macro.

Ci-joint ton fichier en retour ICI==> http://www.cjoint.com/c/GLlnPEfB67u

J’ai du passer par cjoint, car le fichier est trop volumineux, donc clique sur le lien et suis la procédure.

Cordialement.

5

Re @AlainPncl,

Je viens de voir que si aucune feuille n’est sélectionnée dans la cellule “B2”, cela générait une erreur, alors:

Remplacer le code VBA du bouton par celui ci.

 Sub Copie()
 
Derligne = 2
On Error GoTo Fin
Application.EnableEvents = False
Application.ScreenUpdating = False

    With Sheets(Range("B2").Value)
    
        .Rows(Derligne).Insert
            
        Sheets("Menu").Range("B1,B3:B6").Copy
            .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            .Range("A2:E5000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlNo
    
    End With
    
    With Sheets("Tableau général")
       .Rows(Derligne).Insert
            
        Sheets("Menu").Range("B1,B3:B6").Copy
            .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            
    End With
    
    Sheets(Array("Tableau général", "Alpha", "Bravo", "Charlie", "Delta")).Select
    Sheets("Tableau général").Activate
    Rows("2:5000").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A2").Select
    Sheets("Menu").Select
    Worksheets("Menu").Range("B1:B6").ClearContents
    
Application.EnableEvents = True

ActiveWorkbook.Save
Fin:
End Sub
6

Re @AlainPncl,

Comme je n’étais pas satisfait du résultat escompté, j’ai amélioré :wink:

Une seule macro VBA associée avec le bouton “Valider”.

Sub Copiedestination()
 
Derligne = 2
On Error GoTo Fin
Application.EnableEvents = False
Application.ScreenUpdating = False

    With Sheets(Range("B2").Value)
    
        .Rows(Derligne).Insert
            
        Sheets("Menu").Range("B1,B3:B6").Copy
            .Range("A" & Derligne).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
            .Range("A2:E5000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlNo
    
    End With
    
    With Sheets("Tableau général")
       .Rows(Derligne).Insert
            
        Sheets("Menu").Range("B1,B3:B6").Copy
            .Range("A" & Derligne).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
            
    End With
        
    Worksheets("Menu").Range("B1:B6").ClearContents
    
Application.EnableEvents = True

ActiveWorkbook.Save

Fin:
End Sub

Fichier ICI==> AlainPncl V2.xlsm (27,5 Ko)

Cordialement.

7

Merci beaucoup mdo c’est exactement ce que je voulais.

Bravo à toi !!!

@+

8

Bonsoir @AlainPncl,

Content que le résultat te convienne :wink:

Si ton problème est résolu n’oublie pas de cliquer sur le petit :white_check_mark: sous la solution pour la valider.

Cordialement.