Discussion :

[jujudeo]

Bonjour a tous,

Je cherche a faire un copier/coller en fonction d'un nom d'onglet qu'il y a sur mon fichier c'est a dire :

J'ai un classeur avec plusieurs feuilles. La première comporte 4 colonnes qui correspond a des coordonnées de points avec : num point ; X ; Y ; Z. Les feuilles suivantes sont a remplir en fonction des données de la première feuille. Le nom de chaque feuille a remplir correspond au même nom du points de la première feuille. Je cherche donc a faire : je sélectionne mon premier nom de point, je recherche dans le classeur la feuille avec le même nom et je remplir en copier/coller 3 cellules puis je passe au points suivant.

Mon problème est que je n'arrive pas a interagir avec le nom des onglets . J'ai essayé ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public i, ligne As Integer
 
Sub copiercoller()
Dim myRange As Range
Dim Cell As Range
Dim O As Worksheet 'déclare la variable O (Onglets)
 
Set myRange = Sheets("Points").Range("A1:A5000")
  For Each Cell In myRange
    If Cell.Value = O.Name Then
        Sheets("O.Name").Range("A5").Value = "X= " & Sheets("Points").Range("B1").Value
        Sheets("O.Name").Range("C5").Value = "Y= " & Sheets("Points").Range("C1").Value
        Sheets("O.Name").Range("C29").Value = Sheets("Points").Range("D1").Value
    End If
  Next Cell
End Sub

Je mets en PJ un exemple de mon classeur.

Cordialement

Jujudeo

[EricDgn]

Bonjour,

Une façon de faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub copiercoller()
    Dim kR As Long
    ThisWorkbook.Sheets("Points").Activate
    '--- présume que 1er point en ligne 1
    '--- et s'arrête dès que cellule vide en colonne 1 (A)
    kR = 1
    While Cells(kR, 1) <> ""
        With ThisWorkbook.Worksheets(Cells(kR, 1).Value)
            .Range("A5").Value = "X= " & Range("B1").Value
            .Range("C5").Value = "Y= " & Range("C1").Value
            .Range("C29").Value = Range("D1").Value
        End With
        kR = kR + 1
    Wend
End Sub

Cordialement.

[jujudeo]

Bonjour,

merci beaucoup pour votre code, mais sur la feuille points, votre macro code les coordonnées de la première ligne et ne passe pas a la ligne suivante, c'est a dire que pour chaque feuille, il copie toujours les coordonnées de la première ligne.

Or, moi mon but c'est que par exemple si le nom du point est "n°484" sur la feuille "Points", il copie les coordonnées de ce point sur la feuille n°484.

[EricDgn]

Effectivement, j'étais distrait!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub copiercoller()
    Dim kR As Long
    ThisWorkbook.Sheets("Points").Activate
    kR = 1
    '--- présume que 1er point en ligne 1
    '--- et s'arrête dès que cellule vide en colonne A
    While Cells(kR, 1) <> ""
        With ThisWorkbook.Worksheets(Cells(kR, 1).Value)
            .Range("A5").Value = "X= " & Cells(kR, 2).Value
            .Range("C5").Value = "Y= " & Cells(kR, 3).Value
            .Range("C29").Value = Cells(kR, 4).Value
        End With
        kR = kR + 1
    Wend
End Sub

Cordialement.

[jujudeo]

C'est parfait merci beaucoup ! sujet résolu

[jujudeo]

Bonjour,

je re-up cette discussion. Cette macro marche très bien cependant serait il possible de faire le copier-coller en fonction du NOMBRE qu'il y a dans la cellule et dans la l'onglet ? et pas en fonction de son nom ?

Car j'ai des onglets ou il y a un espace a la fin du coup la macro bug.

Ex: j'ai certaines cellules qui s'appellent "n°326" et mon onglet "n°326 " avec un espace juste apres le nombre du coup la macro ne reconnait pas le nom de la cellule.

Je vous remercie par avance.

Julien

[EricDgn]

Bonjour,

Ajouter un Trim() dans la ligne 9 pour supprimer les éventuels espaces devant ou derrière le n°.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With ThisWorkbook.Worksheets(Trim(Cells(kR, 1).Value))

Cordialement.

[jujudeo]

Bonjour,

cela ne marche pas, il me dit que l'indice n'appartient pas a la sélection des la première cellule (qui est bonne), il ne "supprime pas l'espace dans le nom de la feuille"

[EricDgn]

Bonsoir,

Je proposerais d'utiliser la fonction Trim() pour supprimer les espaces (inutiles) en début et fin
- des noms d'onglet
- dans la colonne A de la feuille "Points"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit
 
Sub copiercoller()
    Dim kR As Long
    NettoyerNomsOnglets '<<< ajouté
    ThisWorkbook.Sheets("Points").Activate
    kR = 1
    '--- présume que 1er point en ligne 1
    '--- et s'arrête dès que cellule vide en colonne A
    While Cells(kR, 1) <> ""
        Cells(kR, 1).Value = Trim(Cells(kR, 1).Value)   '<<< ajouté
        With ThisWorkbook.Worksheets(Cells(kR, 1).Value)
            .Range("A5").Value = "X= " & Cells(kR, 2).Value
            .Range("C5").Value = "Y= " & Cells(kR, 3).Value
            .Range("C29").Value = Cells(kR, 4).Value
        End With
        kR = kR + 1
    Wend
End Sub
 
Sub NettoyerNomsOnglets()
    Dim Sh
    For Each Sh In ThisWorkbook.Sheets
        Sh.Name = Trim(Sh.Name)
    Next Sh
End Sub

Cordialement.

[jujudeo]

Merci de votre réponse, mais votre macro pour supprimer l'espace dans le nom de l'onglet ne le supprime pas.

J'ai essayé de lancer en "pas a pas" et je vois bien que le 3e onglet ou il y a un espace, il ne l’enlève pas et ainsi la macro s'arrete.

Votre idée est super car c'est exactement se que je voulais faire, il faut juste qu'elle supprimer bien l'espace.

Julien

[EricDgn]

Bizarre!
Lancez cette macro et notez ce que donne le 3e onglet:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub NettoyerNomsOnglets()
    Dim Sh
    For Each Sh In ThisWorkbook.Sheets
        Sh.Name = Trim(Sh.Name)
        Debug.Print ">" & Sh.Name & "<", Asc(Right(Sh.Name, 1))
    Next Sh
End Sub

Cordialement.

[jujudeo]

Il donne toujours la même chose en l'occurance "n°639 ", l'espace ne disparaît pas.

Mais je ne comprends pas car votre macro ne boucle pas avec le for/next, elle s’exécute une fois comme si il n'y avait pas de next...

[EricDgn]

Bonjour,

Pour voir le résultat de la macro il faut regarder ce qui est affiché dans la fenêtre d'exécution (Ctrl+G dans la fenêtre de l'éditeur de code VBA)

Trim() ---> supprime les espaces en début et fin
Debug.Print ---> inscrit un message dans la fenêtre d'exécution

Consultez l'Aide d'Access (F1) pour ne savoir plus.

Cordialement.

[jujudeo]

quand j’exécute votre macro, dans la fenêtre exécution, il me renseigne ceci : >Feuil1< 49

[EricDgn]

Bonjour,

Il faut lancer la macro en partant d'une feuille du dossier qui contient les points.
Cela devrait donner un résultat de ce genre:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
>Points<       115 
>n°644<        52 
>n°645<        53 
>n°646<        54 
>n°647<        55 
>n°648<        56 
>n°649<        57 
>n°650<        48

indiquant en 2e colonne le code ASCII du dernier caractère ('4'-->52).

Cordialement.

[jujudeo]

C'est bon merci beaucoup j'ai trouvé, le problème. En effet, la macro n'acceptait pas les "ThisWorkbook", il fallait directement que je parte en "Worksheets" c'est pour cela que la boucle ne se faisait pas !

La macro marche niquel merci beaucoup !

[jujudeo]

Et a contrario, j'ai 500 feuilles numérotées de 1 a 500 et j'ai une feuille "Points" de base avec 500 lignes ou en colonne A j'ai 1, 2, 3 ..., est il possible de faire l'inverse ?

Exemple : en feuille Points j'ai le point 1 donc en cellule A1, il cherche la feuille 1 dans mon classeur et copie la cellule A6 de cette feuille 1 vers la cellule B1 de la Feuille "Points". Puis il passe au point 2, il cherche la feuille 2, copie la cellule A6, et la colle en B2 de la feuille "Points" etc ?

[EricDgn]

Bonjour,

Une façon de faire cela:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Reprise()
    Dim kR As Long, Sh
    ThisWorkbook.Sheets("Points").Activate
    '--- présume que 1er point en ligne 1 (pas de ligne de titre)
    For Each Sh In ThisWorkbook.Sheets
        If Sh.Name <> "Points" Then
            Sh.Name = Trim(Sh.Name) '--- retire les espaces inutiles éventuels
            '--- au choix, l'une ou l'autre façon de retrouver le n°
            kR = Mid(Sh.Name, 3)   '--- suppose que les noms d'onglets commencent par n° (n°1, n°2, tec.)
            'kR = Sh.Name            '--- suppose que les noms d'onglets sont le n° (1, 2, 3, etc.)
            With Sh
                Cells(kR, 2) = .Range("A6")   '--- 2 = 2e colonne = B
            End With
        End If
    Next Sh
End Sub

A noter que cela va écraser les valeurs déjà présentes dans la colonne B.
Cordialement.

[jujudeo]

Je l'ai ajusté a ce que je désirai et cela marche parfaitement !! je vous remercie beaucoup de votre implication et le sujet est résolu