Récupéré des données avec saut de colonne

Le 14/11/2014 à 10:54

Bonjour à toute la communauté !!

Après avoir longuement recherché réponses à mes questions sur internet et sur divers forum, je n'ai pas réussi à trouver "chaussures à mon pied" ou plutôt "programme et code adapté à mes besoins". C'est pourquoi, je me redirige vers vous.

J'ai besoin de mettre en place un système de récupération de données entre deux fichiers Excel différents.

Mes données se trouvent dans un premier fichier nommé "RecuperationDonnees.xlsm" et elles sont situées respectivement aux emplacements suivants : "E13;E14;E17;E18;E19" puis "L13;L14;L17;L18;L19" puis "S13;S14;S17;S18;S19" puis "Z13;Z14;Z17;Z18;Z19" puis "AG13;AG14;AG17;AG18;AG19" puis ..... ( et ainsi de suite, on peut déjà constater qu'il y a un saut de 7 colonnes pour chacune des plages de données )

J'ai ensuite besoin de copier ces éléments là sur le second fichier nommé "Courbe Delta Hrs.xlsm" aux emplacements suivants : "AU61;AU62;AU63;AU64;AU65" puis "AV61;AV62;AV63;AV64;AV65" puis "AW61;AW62;AW63;AW64;AW65" puis ..... ( et ainsi de suite, avec cette fois ci aucun saut de colonne car j'ai besoin d'énumérer les données les unes derrières les autres )

Les difficultés que j'ai rencontré :

  • c'est tout d'abord pour récupérer des données sur des cellules qui ne se suivent pas (comme par exemple une plage A5:A10)
  • ensuite c'est pour les récupérer d'un fichier X à un fichier Y
  • il y a aussi la possibilité de récupérer l'information des semaines et des années (si nécessité) qui se localisent sur le premier fichier en E6 puis L6 puis S6 puis Z6 puis AG6 "et ainsi de suite" et pour le second fichier en AU60 puis AV60 puis AW60 "et ainsi de suite". J'avais pensé à peut être mettre une condition qui compare la cellule d'un premier fichier avec celle du second, afin que les données soient renvoyées à condition qu'il s'agisse du même numéro de semaine (et du même numéro d'année cellule E4 - L4 - S4 - Z4 - AG4 - ... pour le premier fichier, et pour le second au niveau des cellules AU59 - AV59 - AW59 - ... )
  • serait-il possible de créer ce programme sous forme de macro VBA ? n'étant pas un professionnel du décalage de colonne et des récupérations de données, pourriez vous éclairer ma lanterne ^^ ?

Merci à tout ceux qui ont pris le temps de lire mon Article et, d'autant plus, à tout ceux qui prendront le temps de me répondre.

Si je n'ai pas été claire sur mes attentes, n'hésitez pas à me demander des compléments d'informations

En attente de vous lire.

Cordialement

Grégoire.G

Le 14/11/2014 à 15:24

Bonjour Grégoire, bonjour le forum,

Tu as oublié de préciser les noms des onglets source et destination... Essaie le code ci-dessous à adapter et à placer dans le classeur RecuperationDonnees.xlsm :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim DC As Integer 'déclare la variable CD (Dernière Colonne)
Dim TV() As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
CH = CS.Path & "\" 'définit le chemin CH
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
Set CD = Workbooks("Courbe Delta Hrs.xlsm")
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open (CH & "Courbe Delta Hrs.xlsm") 'ouvre le classeur "Courbe Delta Hrs.xlsm"
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("Feuil1") 'définit l'onglet de destination OD (à adapter)
'définit la dernière colonne éditée DC de la ligne 6 de l'onglet OS
DC = OS.Cells(6, Application.Columns.Count).End(xlToLeft).Column
For I = 5 To DC Step 7 'boucle sur toutes les colonnes de 5 à DC par pas de 7
    ReDim Preserve TV(5, J) 'redimensionne le tableau de valeurs TV (6 lignes [de 0 à 5], J colonnes [de 0 à J])
    TV(0, J) = OS.Cells(6, I) 'récupère la semaine en ligne 6
    TV(1, J) = OS.Cells(13, I) 'récupère la valeur en ligne 13
    TV(2, J) = OS.Cells(14, I) 'récupère la valeur en ligne 14
    TV(3, J) = OS.Cells(17, I) 'récupère la valeur en ligne 17
    TV(4, J) = OS.Cells(18, I) 'récupère la valeur en ligne 18
    TV(5, J) = OS.Cells(19, I) 'récupère la valeur en ligne 19
    J = J + 1 'incrémente J
Next I 'prochaine colonne de la boucle
'place dans la cellule AU61 (redimensionnée à la taille du tableau TV) de l'onglet OD les valeurs du tableau TV
OD.Range("AU61").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
End Sub
Le 14/11/2014 à 15:44

Bonjour ThauThème,

Merci beaucoup de ta rapidité à me répondre.

Je vais tester ton code et je reviendrai vers ce Topic pour te donner le rendu.

Parcontre j'ai une ou deux questions, sur la ligne :

"On Error GoTo 0 'annule la gestion des erreurs

Set OD = CD.Sheets("Feuil1") 'définit l'onglet de destination OD (à adapter)

'définit la dernière colonne éditée DC de la ligne 6 de l'onglet OS"

Que représente l'onglet "Feuil1" ?

Lorsque tu mets en commentaire "définit la dernière colonne éditée DC", je ne vois pas où est l'information DernièreColonne dans le bout de code du dessus ?

Je vais m'empresser d'adapter et de tester tout ca, et je reviendrai vers toi

Bon Week End à toi !!

Grégoire.G

Le 14/11/2014 à 18:40

Bonsoir Grégoire, bonsoir le forum,

Comme je t'ai dit dans mon premier post tu as oublié de préciser le nom des onglets source et destination.

Pour faire des copier/coller entre différents classeurs il faut connaître :

• le nom du classeur source

• le nom de l'onglet dans ce classeur source (manquant)

• l'adresse de la cellule ou de la plage à copier dans cet onglet

• le nom du classeur destination

• le nom de l'onglet dans ce classeur destination (manquant)

• l'adresse de la cellule ou de la plage dans cet onglet destination

Dans le code, j'ai défini les noms manquants comme étant l'onglet Feuil1 de chaque classeur. Il te faudra adapter ces noms à la réalité de tes classeurs...

Je mets le commentaire en bout de ligne mais si la ligne est trop longue je place le commentaire au-dessus de la ligne. Donc le commentaire : 'définit la dernière colonne éditée DC de la ligne 6 de l'onglet OS s'adressait à la ligne :

DC = OS.Cells(6, Application.Columns.Count).End(xlToLeft).Column
Le 17/11/2014 à 09:21

Bonjour ThauTheme,

Je viens de faire tourner ton code sur mon programme en complétant les éléments manquants, mais petit problème, le programme tourne dans le vide, sans modifier quoi que sesoit.

Je te renvoi le code avec les différents champs remplis, pourrais-tu me dire si il y a un des champs qui est mal orthographié ou mal inséré.

Merci d'avance !!!

Sub MacroOoOo()
Dim CS As Workbook 'déclare la variable CS (Classeur Source): RecuperationDonnees.xlsm
Dim OS As Object 'déclare la variable OS (Onglet Source) : Feuil1
Dim CH As String 'déclare la variable CH (CHemin d'accès) : D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34
Dim CD As Workbook 'déclare la variable CD (Classeur Destination): Courbe Delta Hrs.xlsm
Dim OD As Object 'déclare la variable OD (Onglet Destination) : Details TU
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim TV() As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
CH = CS.Path & "\GGONZALES\Bureau\Boulot\2nd Partie\Partie Tuyauterie\" 'définit le chemin CH
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
Set CD = Workbooks("Courbe Delta Hrs.xlsm")
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open (CH & "Courbe Delta Hrs.xlsm") 'ouvre le classeur "Courbe Delta Hrs.xlsm"
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("Details TU") 'définit l'onglet de destination OD (à adapter)
'définit la dernière colonne éditée DC de la ligne 6 de l'onglet OS
DC = OS.Cells(6, Application.Columns.Count).End(xlToLeft).Column
For I = 5 To DC Step 7 'boucle sur toutes les colonnes de 5 à DC par pas de 7
    ReDim Preserve TV(5, J) 'redimensionne le tableau de valeurs TV (6 lignes [de 0 à 5], J colonnes [de 0 à J])
    TV(0, J) = OS.Cells(6, I) 'récupère la semaine en ligne 6
    TV(1, J) = OS.Cells(13, I) 'récupère la valeur en ligne 13
    TV(2, J) = OS.Cells(14, I) 'récupère la valeur en ligne 14
    TV(3, J) = OS.Cells(17, I) 'récupère la valeur en ligne 17
    TV(4, J) = OS.Cells(18, I) 'récupère la valeur en ligne 18
    TV(5, J) = OS.Cells(19, I) 'récupère la valeur en ligne 19
    J = J + 1 'incrémente J
Next I 'prochaine colonne de la boucle
'place dans la cellule AU61 (redimensionnée à la taille du tableau TV) de l'onglet OD les valeurs du tableau TV
OD.Range("AU61").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
End Sub

Merci vraiment ThauTheme, tu me files un sacré coup de main !!

En attente d'une réponse de ta part,

Bonne journée !

Grégoire.G

Le 17/11/2014 à 14:00

Bonjour Grégoire, bonjour le forum,

En relisant l'énoncé de ton problème, je viens de me rendre compte que j'avais pris la ligne 6 comme base pour calculer la dernière colonne DC alors qu'en fait, l'information des semaines se trouvent dans la ligne 4 (tu aurais dû t'en rendre compte par toi-meme ! Ça sert à quoi que je commente les code ?...)

Le code qui devrait fonctionner devient :

Sub MacroOoOo()
Dim CS As Workbook 'déclare la variable CS (Classeur Source): RecuperationDonnees.xlsm
Dim OS As Object 'déclare la variable OS (Onglet Source) : Feuil1
Dim CH As String 'déclare la variable CH (CHemin d'accès) : D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34
Dim CD As Workbook 'déclare la variable CD (Classeur Destination): Courbe Delta Hrs.xlsm
Dim OD As Object 'déclare la variable OD (Onglet Destination) : Details TU
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim TV() As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
CH = "D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34\" 'définit le chemin CH
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
Set CD = Workbooks("Courbe Delta Hrs.xlsm")
If Err <> 0 Then 'condition : si une erreur a été générée
   Err.Clear 'efface l'erreur
   Workbooks.Open (CH & "Courbe Delta Hrs.xlsm") 'ouvre le classeur "Courbe Delta Hrs.xlsm"
   Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("Details TU") 'définit l'onglet de destination OD (à adapter)
'définit la dernière colonne éditée DC de la ligne 4 de l'onglet OS
DC = OS.Cells(4, Application.Columns.Count).End(xlToLeft).Column
For I = 5 To DC Step 7 'boucle sur toutes les colonnes de 5 à DC par pas de 7
   ReDim Preserve TV(5, J) 'redimensionne le tableau de valeurs TV (6 lignes [de 0 à 5], J colonnes [de 0 à J])
   TV(0, J) = OS.Cells(4, I) 'récupère la semaine en ligne 4
   TV(1, J) = OS.Cells(13, I) 'récupère la valeur en ligne 13
   TV(2, J) = OS.Cells(14, I) 'récupère la valeur en ligne 14
   TV(3, J) = OS.Cells(17, I) 'récupère la valeur en ligne 17
   TV(4, J) = OS.Cells(18, I) 'récupère la valeur en ligne 18
   TV(5, J) = OS.Cells(19, I) 'récupère la valeur en ligne 19
   J = J + 1 'incrémente J
Next I 'prochaine colonne de la boucle
'place dans la cellule AU61 (redimensionnée à la taille du tableau TV) de l'onglet OD les valeurs du tableau TV
OD.Range("AU61").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
End Sub

Vérifie le chemin d'accès CH car je ne suis pas sûr...

Le 17/11/2014 à 15:53

Bonjour ThauThème, bonjour à Tous,

J'ai ré-essayé de faire fonctionner les lignes de codes, mais je rencontre une difficulté au niveau de la ligne "

Set Od = CD.Sheets("Détails TU")

. Le message d'erreur qui s'affiche est : " l'indice n'appartient pas à la selection".

Je suspecte le fait que le fichier ne soit pas directement ciblé à un moment de la compilation du code.

Lors d'un essai précédent j'ai reussi à faire apparaitre du texte mais qui ne correspond pas à celui des cellules désignées, donc je vais rechercher dans cette direction.

Voilà l'évolution, je reviendrai vers ce forum dès que j'aurai trouvé une solution.

Cordialement

Grégoire.G

Le 17/11/2014 à 16:32

Bonjour Grégoire, bonjour le forum,

Es-tu sûr, au caractère près, de l'orthographe de Détails TU ? Car l'erreur que tu évoques est courante si il y a un espace en plus ou un accent en moins...

De mon coté j'ai testé avec deux fichiers que j'ai créés en reprenant ton environnement et ça marche impeccable !

Enregistre les deux fichiers en pièces jointes dans un même répertoire et tu verras...

14courbe-delta-hrs.xlsm (8.80 Ko)
14recuperationdonnees.xlsm (20.24 Ko)
Le 18/11/2014 à 08:49

Bonjour à toi ThauThème,

Bonjour à vous, le forum

Je viens de tester tes deux fichiers Excel, et ca marche effectivement parfaitement !! Ce serait si bien si ca pouvait se calquer sur mes deux fichiers

J'ai constaté un petit détail qui pourrait avoir son importance. De mon côté, les données à copier d'un fichier à l'autre sont des Valeurs (des heures, des sommes d'argent, des % d'avancements et des quantités). Est ce que cela pourrait gêner la récupération des données ?

Cordialement

Grégoire.G

Le 18/11/2014 à 12:09

Bonjour ThauThème,

Me revoilà ^^

Je viens de réaliser des tests sur mon nouveau fichier basé sur le tien. J'ai essayé d'adapter au maximum à mes attentes, la difficulté est qu'il y a encore quelques lignes de codes dont je ne comprends pas le fonctionnement ^^"

Je souhaite récupérer les valeurs du fichier "RecuperationDonnees.xlsm" et de les coller sur le fichier "Courbe Delta Hrs.xlsm" (d'après toi, penses tu que les espaces dans le nom du second fichier puisse poser problème ?)

Je n'arrive pas à récupérer les bonnes données dans les colonnes du premier fichier, je ne sais pas vraiment pourquoi ?

Pourrais-tu me donner ton avis sur le code que je te transmet, il a été un peu modifié mais en continuité avec celui que tu m'as communiqué.

Sub MacroOoOo()
Dim CS As Workbook 'déclare la variable CS (Classeur Source): RecuperationDonnees.xlsm
Dim OS As Object 'déclare la variable OS (Onglet Source) : Feuil1
Dim CH As String 'déclare la variable CH (CHemin d'accès) : D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34\Courbe Delta Hrs.xlsm
Dim CD As Workbook 'déclare la variable CD (Classeur Destination): Courbe Delta Hrs.xlsm
Dim OD As Object 'déclare la variable OD (Onglet Destination) : Details TU
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim TV() As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
estouvert = False

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS (à adapter)
CH = CS.Path & "\" 'définit le chemin CH : "D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34\"
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
Set CD = Workbooks("Courbe Delta Hrs.xlsm")

If Err <> 0 Then 'condition : si une erreur a été générée
   Err.Clear 'efface l'erreur
End If 'fin de la condition

Windows("RecuperationDonnees.xlsm").Activate 'passe sur le fichier recuperationdonnees
'Test si le fichier est déjà ouvert
For Each fich In Workbooks
If fich.Name = "Courbe Delta Hrs.xlsm" Then estouvert = True
Next
If estouvert = False Then Workbooks.Open ("D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34\Courbe Delta Hrs.xlsm")

'Workbooks.Open (CH & "Courbe Delta Hrs.xlsm") 'ouvre le classeur "Courbe Delta Hrs.xlsm"
Windows("Courbe Delta Hrs.xlsm").Activate 'passe sur le fichier recuperationdonnees
Set CD = ActiveWorkbook 'définit le classeur destination CD

On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("details TU") 'définit l'onglet de destination OD (à adapter)
'définit la dernière colonne éditée DC de la ligne 4 de l'onglet OS
DC = OS.Cells(4, Application.Columns.Count).End(xlToLeft).Column

For I = 5 To Z Step 7 'boucle sur toutes les colonnes de 5 à DC par pas de 7
   ReDim Preserve TV(14, J) 'redimensionne le tableau de valeurs TV (18 lignes [de 0 à 14], J colonnes [de 0 à J])
' Première série de données relatif au >>CO2<<
   'TV(0, J) = OS.Cells(6, I) 'récupère la semaine en ligne 6 (N° Semaine)
   TV(0, J) = OS.Cells(13, I) 'récupère la valeur en ligne 13
   TV(1, J) = OS.Cells(14, I) 'récupère la valeur en ligne 14
   TV(2, J) = OS.Cells(17, I) 'récupère la valeur en ligne 17
   TV(3, J) = OS.Cells(18, I) 'récupère la valeur en ligne 18
   TV(4, J) = OS.Cells(19, I) 'récupère la valeur en ligne 19
' Première série de données relatif au >>PE.PB<<
   'TV(6, J) = OS.Cells(6, I) 'récupère la semaine en ligne 6 (N° Semaine)
   TV(5, J) = OS.Cells(25, I) 'récupère la valeur en ligne 13
   TV(6, J) = OS.Cells(26, I) 'récupère la valeur en ligne 14
   TV(7, J) = OS.Cells(29, I) 'récupère la valeur en ligne 17
   TV(8, J) = OS.Cells(30, I) 'récupère la valeur en ligne 18
   TV(9, J) = OS.Cells(31, I) 'récupère la valeur en ligne 19
' Première série de données relatif au >>Acier/Inox<<
   'TV(12, J) = OS.Cells(6, I) 'récupère la semaine en ligne 6 (N° Semaine)
   TV(10, J) = OS.Cells(37, I) 'récupère la valeur en ligne 13
   TV(11, J) = OS.Cells(38, I) 'récupère la valeur en ligne 14
   TV(12, J) = OS.Cells(41, I) 'récupère la valeur en ligne 17
   TV(13, J) = OS.Cells(42, I) 'récupère la valeur en ligne 18
   TV(14, J) = OS.Cells(43, I) 'récupère la valeur en ligne 19
' incrémentation de J
   J = J + 1
Next I 'prochaine colonne de la boucle

'place dans la cellule AU61 (redimensionnée à la taille du tableau TV) de l'onglet OD les valeurs du tableau TV
OD.Range("AU61").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
End Sub

Il m'affiche une erreur lorsque je compile le code, notamment sur la dernière ligne:

OD.Range("AU61").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV

Je ne vois pas d'où pourrais venir l'erreur

Je te remercie d'avance et tous les internautes qui seraient prêt à me donner un coup de main.

Cordialement

Grégoire.G

Le 18/11/2014 à 13:54

Bonjour Grégoire, bonjour le forum,

Je vois des changements dans le code mais je suis incapable de savoir si il impactent la réalisation de la macro.

Il nous faudrait 4 choses pour pouvoir te donner une réponse claire et certainement la solution :

1 - le chemin d'accès complet du classeur Source

2 - le chemin d'accès complet du classeur Destination

3 - Le classeur Source en pièce jointe

4 - le classeur Destination en pièce jointe

Le 18/11/2014 à 14:33

Bonjour ThauThème,

L'ensemble à l'air de fonctionner correctement, j'ai réussi à trouver une alternative au passage d'un fichier A à un fichier B en créant un nouvel onglet sur le fichier Recuperationdonnees.xlsm dans lequel je récupère toutes les informations à travers le code que tu m'as transmis puis je copie toutes ces informations sur le second fichier par l'intermédiaire d'un simple copier/coller.

Donc tout fonctionne comme je le souhaitais.

Merci énormément de ton Aide ThauThème, sans toi je n'aurai pu aller si loin dans le code.

Merci aussi du temps que tu m'as accordé et de la patience dont tu as fait preuve

Je te souhaite une bonne continuation et j'espère à bientôt.

Cordialement

Grégoire.G

Le 21/11/2014 à 14:33

Bonjour le Forum,

Suite aux difficultés rencontrées la semaine dernière, j'ai réussi à mettre en place un code me permettant de récupérer les données d'un onglet nommé "Feuil2" et de les copier sur le même document sur l'onglet nommé "Feuil3". Sur mon fichier initial, je rencontre aucune difficulté, et l'opération se fait sans encombre.

Par contre, j'ai souhaité faire un second fichier avec exactement la même mise en page, les mêmes emplacements, les mêmes noms d'onglet, sauf que je n'ai pas le même nombre de cellule à copier et je n'ai pas le même nom de fichier. Donc j'ai essayé de retoucher mon fichier pour l'adapter à mon nouveau besoin.

Les nouvelles lignes de code me semblaient bonnes, jusqu'à ce que je compile...

Il m'affiche une erreur d'exécution '9' : L'indice n'appartient pas à la selection...

Après une longue, très longue après midi de recherche ... je ne parviens toujours pas à trouver où se trouve la boulette.

Pourriez vous m'aider à trouver l'erreur s'il vous plait.

Voici mon code :

Sub MacroRecup() ' Fonctionne pas ...

Dim CS As Workbook 'déclare la variable CS (Classeur Source): RecuperationDonneesAM.xlsm
Dim OS As Object 'déclare la variable OS (Onglet Source) : Feuil2
Dim CH As String 'déclare la variable CH (CHemin d'accès) :
Dim CD As Workbook 'déclare la variable CD (Classeur Destination): RecuperationDonneesAM.xlsm
Dim OD As Object 'déclare la variable OD (Onglet Destination) : Feuil3
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim TV() As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Call CopierDonnees

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil2") 'définit l'onglet source OS (à adapter)
CH = CS.Path & "\" 'définit le chemin CH :
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
Set CD = ThisWorkbook 'définit le classeur Destination CD

If Err <> 0 Then 'condition : si une erreur a été générée
   Err.Clear 'efface l'erreur
End If 'fin de la condition

On Error GoTo 0 'annule la gestion des erreurs
Set OD = CS.Sheets("Feuil3") 'définit l'onglet de destination OD (à adapter)
'définit la dernière colonne éditée DC de la ligne 4 de l'onglet OS
DC = OS.Cells(4, Application.Columns.Count).End(xlToLeft).Column

For I = 5 To DC Step 7 'boucle sur toutes les colonnes de 5 à DC par pas de 7
   ReDim Preserve TV(4, J) 'redimensionne le tableau de valeurs TV (5 lignes [de 0 à 4], J colonnes [de 0 à J])
' Série de données relatif au secteur AM
   'TV(0, J) = OS.Cells(6, I) 'récupère la semaine en ligne 6 (N° Semaine)
   TV(0, J) = OS.Cells(9, I) 'récupère la valeur en ligne 9
   TV(1, J) = OS.Cells(10, I) 'récupère la valeur en ligne 10
   TV(2, J) = OS.Cells(11, I) 'récupère la valeur en ligne 11
   TV(3, J) = OS.Cells(12, I) 'récupère la valeur en ligne 12
   TV(4, J) = OS.Cells(13, I) 'récupère la valeur en ligne 13
' incrémentation de J
   J = J + 1
Next I 'prochaine colonne de la boucle

'If MsgBox("Est ce que le fichier ~ Courbe Delta Hrs ~ est ouvert ?", vbYesNo, "Demande de confirmation") = vbNo Then
'Workbooks.Open Filename:="D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34\Courbe Delta Hrs.xlsm" ', Password:="AVCTEL", WriteResPassword:="AVCTEL"
'End If

'Windows("courbe delta hrs.xls").Active
'Sheets("Details TU").Select
'Windows("RecuperationDonneesAM.xlsm").Activate

Sheets("Feuil3").Select

'place dans la cellule AU61 (redimensionnée à la taille du tableau TV) de l'onglet OD les valeurs du tableau TV
' OD.Range("C5").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
OD.Range("C5").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
End Sub

Lorsque l'erreur s'affiche, la ligne de code surlignée en jaune est la suivante :

OD.Range("C5").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV

Peut être que l'erreur vient de plus haut, mais je ne vois vraiment pas d'où.

Merci d'avance pour votre Aide !!!

Cordialement

Grégoire.G

Le 21/11/2014 à 15:06
twinsen44 a écrit :

Bonjour le Forum,

Suite aux difficultés rencontrées la semaine dernière, j'ai réussi à mettre en place un code me permettant de récupérer les données d'un onglet nommé "Feuil2" et de les copier sur le même document sur l'onglet nommé "Feuil3". Sur mon fichier initial, je rencontre aucune difficulté, et l'opération se fait sans encombre.

Par contre, j'ai souhaité faire un second fichier avec exactement la même mise en page, les mêmes emplacements, les mêmes noms d'onglet, sauf que je n'ai pas le même nombre de cellule à copier et je n'ai pas le même nom de fichier. Donc j'ai essayé de retoucher mon fichier pour l'adapter à mon nouveau besoin.

Les nouvelles lignes de code me semblaient bonnes, jusqu'à ce que je compile...

Il m'affiche une erreur d'exécution '9' : L'indice n'appartient pas à la selection...

Après une longue, très longue après midi de recherche ... je ne parviens toujours pas à trouver où se trouve la boulette.

Pourriez vous m'aider à trouver l'erreur s'il vous plait.

Voici mon code :

Sub MacroRecup() ' Fonctionne pas ...

Dim CS As Workbook 'déclare la variable CS (Classeur Source): RecuperationDonneesAM.xlsm
Dim OS As Object 'déclare la variable OS (Onglet Source) : Feuil2
Dim CH As String 'déclare la variable CH (CHemin d'accès) :
Dim CD As Workbook 'déclare la variable CD (Classeur Destination): RecuperationDonneesAM.xlsm
Dim OD As Object 'déclare la variable OD (Onglet Destination) : Feuil3
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim TV() As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Call CopierDonnees

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil2") 'définit l'onglet source OS (à adapter)
CH = CS.Path & "\" 'définit le chemin CH :
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
Set CD = ThisWorkbook 'définit le classeur Destination CD

If Err <> 0 Then 'condition : si une erreur a été générée
   Err.Clear 'efface l'erreur
End If 'fin de la condition

On Error GoTo 0 'annule la gestion des erreurs
Set OD = CS.Sheets("Feuil3") 'définit l'onglet de destination OD (à adapter)
'définit la dernière colonne éditée DC de la ligne 4 de l'onglet OS
DC = OS.Cells(4, Application.Columns.Count).End(xlToLeft).Column

For I = 5 To DC Step 7 'boucle sur toutes les colonnes de 5 à DC par pas de 7
   ReDim Preserve TV(4, J) 'redimensionne le tableau de valeurs TV (5 lignes [de 0 à 4], J colonnes [de 0 à J])
' Série de données relatif au secteur AM
   'TV(0, J) = OS.Cells(6, I) 'récupère la semaine en ligne 6 (N° Semaine)
   TV(0, J) = OS.Cells(9, I) 'récupère la valeur en ligne 9
   TV(1, J) = OS.Cells(10, I) 'récupère la valeur en ligne 10
   TV(2, J) = OS.Cells(11, I) 'récupère la valeur en ligne 11
   TV(3, J) = OS.Cells(12, I) 'récupère la valeur en ligne 12
   TV(4, J) = OS.Cells(13, I) 'récupère la valeur en ligne 13
' incrémentation de J
   J = J + 1
Next I 'prochaine colonne de la boucle

'If MsgBox("Est ce que le fichier ~ Courbe Delta Hrs ~ est ouvert ?", vbYesNo, "Demande de confirmation") = vbNo Then
'Workbooks.Open Filename:="D:\GGONZALES\Bureau\Boulot\2nd Partie\Global Projet A34\Courbe Delta Hrs.xlsm" ', Password:="AVCTEL", WriteResPassword:="AVCTEL"
'End If

'Windows("courbe delta hrs.xls").Active
'Sheets("Details TU").Select
'Windows("RecuperationDonneesAM.xlsm").Activate

Sheets("Feuil3").Select

'place dans la cellule AU61 (redimensionnée à la taille du tableau TV) de l'onglet OD les valeurs du tableau TV
' OD.Range("C5").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
OD.Range("C5").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV
End Sub

Lorsque l'erreur s'affiche, la ligne de code surlignée en jaune est la suivante :

OD.Range("C5").Resize(UBound(TV, 1) + 1, UBound(TV, 2) + 1) = TV

Peut être que l'erreur vient de plus haut, mais je ne vois vraiment pas d'où.

Merci d'avance pour votre Aide !!!

Cordialement

Grégoire.G

Rebonjour le Forum,

Je viens de trouver d'où venait le problème, il s'agit en réalité de la ligne de code :

DC = OS.Cells(4, Application.Columns.Count).End(xlToLeft).Column

Normalement DC devrait prendre pour valeur 256, pour avoir le nombre de colonne récupéré, or dans mon fichier, OD prenait pour valeur 2 ... donc cela m'empêché de créer mon tableau comme je le souhaitais initialement.

Le problème localisé, il me suffisait plus qu'a faire en sorte de retrouver une valeur de 256. Donc face à un problème tout bête, j'ai essayé de trouver une solution toute bête elle-aussi.

DC = 256

Voici la solution pour laquelle j'ai opté ^^.

Merci à toi ThauThème de toute l'aide que tu m'as apporté !!

A bientôt je l'espère.

Bonne journée à vous tous !!!

Grégoire.G

Le 21/11/2014 à 16:13

Bonjour Grégoire, bonjour le forum,

Au départ je ne savais pas combien de colonnes tu utilisais. Pour le savoir, une méthode simple consiste à se positionner dans une ligne contenant forcément une données dans la dernière colonne (sans fichier exemple, il m'a fallu déduire) pour ensuite atteindre cette données, comme on le ferait au clavier avec la combinaison de touche [Fin]+[Flèche vers la gauche] et récupérer le numéro de cette colonne dans une variable (DC dans ton cas).

La ligne de code ci-dessous :

DC = OS.Cells(4, Application.Columns.Count).End(xlToLeft).Column

s'appliquait à la ligne 4. En lisant les commentaires tu aurais dû comprendre !...

Si dans ton nouvel exemple la ligne 4 n'a des valeurs que dans les colonne A et B, ou seulement la B, DC va renvoyer 2. C'est logique !

Comme le tableau TV dépend de DC il est normal que ça plante.

Ta solution de prendre TOUTES les colonnes (sous excel 2003) avec DC=256 est, à mon goût un peut radicale et risque de faire tourner le code pour rien...

Une autre remarque :

Tu as supprimé la ligne, dans la gestion des erreurs, en dessous de Err.Clear :

Set CD = ActiveWorkbook

Du coup, toute la partie de gestion des erreur est inutile. Tu peux supprimer les lignes de On Error Resume Next jusqu'à On Error Goto 0. Cette gestion permettait d'ouvrir le classeur Destination au cas où celui-ci n'aurais pas été déjà ouvert...

Rechercher des sujets similaires à "recupere donnees saut colonne"