Macro choix feuille précise

Bonjour,

J'ai cherché dans le forum une réponse à ma question mais les thermes souvent utilisés ne me parle pas car je suis débutant.

Alors voici ma question :

J' ai un fichier (joint) avec en feuille 1 un petit tableau de 2 colonnes et 7 lignes ainsi que 8 feuilles supplémentaires (A,B,C,D...).

La feuille 1 qui sert de menu de base dans laquelle j'entre des données en colonne B.

J'ai un bouton macro qui me sert en cliquant dessus (par l'insertion d'une ligne et copié, collé) à inserer une nouvelle ligne et à mettre ces données dans les cases correspondantes dans une des pages A,B,C,D...

Pour l'insertion de ligne et copié collé via cette macro je sais faire.

Le problème c'est que je ne sais pas comment faire pour que les données aillent dans la bonne feuille (A,B,C,D...).

Cette donnée sera a chaque fois précisé dans la cellule B7 de la feuille 1 pour indiquer dans quelle page tout doit se coller.

J’espère avoir été précis

merci d'avance

Bonjour,

pour copier/coller dans la bonne feuille

Sub Rectangle2_clic()
    With Sheets("feuil1")
        .Range("B1:B6").Copy 'copie des cellules
        Set sh = Sheets(.Range("B7").Value) 'sh feuille cible
        dl = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' dl ligne cible
        If dl < 3 Then dl = 3
        sh.Range("A" & dl).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'collage des cellules en ligne
    End With
End Sub

Merci pour votre réponse mais je fais comment ? Je suis allé copier votre code dans la macro de mon bouton mais ca ne fonctionne pas .

En même temps je ne sais pas bien où il faut coller ca avec précision.

Bonjour,

il s'agit d'une nouvelle version de ta macro rectangle2_clic à associer à ton bouton valider.

Bonjour deikeen, h2so4

Si je ne me trompe tu colles à la place de ton code dans le bouton Valider

mais si tu veux effacer des données Feuil1

tu rajoute une ligne , comme ceci

If dl < 2 Then dl = 2
            sh.Range("A" & dl).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'collage des cellules en ligne
            Sheets("Feuil1").Range("B1:B7").Delete

au lieu de

If dl < 2 Then dl = 2
        sh.Range("A" & dl).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'collage des cellules en ligne

Bye

Désolée h2so4, nous nous sommes croisés. Bonne journée

Oui c'est bien ce que je pensais mais je ne sais pas où la coller avec précision je viens d’essayer et ca bug pas un message qui me dit fin ou débogage.

Il faut que sur la page sélectionnée une nouvelle ligne s'insert est ce à cause de ca que ca bug ?

Bonjour,

macro ajoutée dans ton fichier

Merci pour ta réactivité H2so4, c'est nickel. A moi de repérer ton code pour le copier dans mon futur tableau.

Encore merci

Encore moi désolé mais un souci se pose car ca insert bien une ligne sauf que celle ci n'est ni encadré et se retrouve en bas alors que mon tableau doit inserer une ligne en haut ligne 3 à chaque fois.

Je suis désolé mais c'est un point important

Bonjour,

voici une version adaptée

Sub Rectangle2_clic()
    With Sheets("feuil1")
        Set sh = Sheets(.Range("B7").Value)    'sh feuille cible
        sh.Rows(3).Insert shift:=xlDown 'insérer nouvelle ligne en 3
        .Range("B1:B6").Copy ' copie des données
        sh.Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True    'collage des données en ligne 3
        With sh.Range("A3:F3")
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
        .Range("B1:B7").ClearContents
    End With
End Sub

Excellent !!!! C'est exactement ca, Merci merci merci !!!!!

Bonjour

modification de la macro

A+

Maurice

Sub valider()
Application.ScreenUpdating = False
   With Sheets("feuil1")
      .Range("B1:B6").Copy 'copie des cellules
      Set Sh = Sheets(.Range("B7").Value) 'sh feuille cible
      Dl = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' dl ligne cible
      If Dl < 2 Then Dl = 2
         Sh.Range("A" & Dl).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'collage des cellules en ligne
         Sh.Range("A" & Dl & ":F" & Dl).Borders.LineStyle = xlContinuous
      Range("B1:B7").ClearContents
   End With
 Application.CutCopyMode = False
End Sub

Re

et pour finir test Valeur

Sub valider()
Application.ScreenUpdating = False
   With Sheets("feuil1")
   If .Range("B7").Value = "" Then MsgBox "Manque Valeur": Exit Sub
      .Range("B1:B6").Copy 'copie des cellules
      Set Sh = Sheets(.Range("B7").Value) 'sh feuille cible
      Dl = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' dl ligne cible
      If Dl < 2 Then Dl = 2
         Sh.Range("A" & Dl).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'collage des cellules en ligne
         Sh.Range("A" & Dl & ":F" & Dl).Borders.LineStyle = xlContinuous
      Range("B1:B7").ClearContents
   End With
 Application.CutCopyMode = False
End Sub

A+

Maurice

H2O

Un dernier service pour mon tableau qui avance a grand pas (pour moi) pourrais tu faire en sorte (dans ma macro) que la ligne qui s’insère à chaque fois dans la feuille pré pro 1 par exemple en colonne A ligne 4 un numéro partant du 1 qui s'incrémente automatiquement au fur et a mesure qu'une ligne s'ajoute ?

merci

Bonjour

avec numérotation de ligne

A+

Maurice

Sub valider()
Application.ScreenUpdating = False
   With Feuil1
   If .Range("B15").Value = "" Then MsgBox "Manque Valeur": Exit Sub
      .Range("B2:B14").Copy 'copie des cellules
      Set Sh = Sheets(.Range("B15").Value) 'sh feuille cible
      Dl = Sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' dl ligne cible
      If Dl < 2 Then Dl = 2
         Sh.Range("B" & Dl).PasteSpecial Paste:=xlPasteValues, Transpose:=True 'collage des cellules en ligne
         Sh.Range("A" & Dl).Value = Application.Max(Sh.Columns(1)) + 1
         Sh.Range("A" & Dl & ":N" & Dl).Borders.LineStyle = xlContinuous
      Range("B2:B15").ClearContents
   End With
 Application.CutCopyMode = False
End Sub

Merci Maurice comment dois je faire pour ajouter à ma macro actuelle , je colle l’ensemble de ton code à la suite du mien ?

Ou peux tu m'envoyer la macro complète (si possible bien sur) car moi je suis nul

Merci

bonjour

il faut cherche un peux

retour de ton fichier

A+

Maurice

Merci Maurice

Oui je sais il faut chercher et se creuser un peu la tête et c'est justement ce que je fais depuis ce matin mais quand on est nul en macro et VBA c'est vraiment pas évident. Je regarde bien les codes pour essayer de comprendre ca va pour certaines choses mais pas tout malheureusement.

J'aimerais savoir faire de moi même

Mais des pros comme vous sont aussi là par passion j'imagine surtout le dimanche

encore merci