Programme qui marchait, ne fonctionne plus HELP !!!!

Vannillaa

XLDnaute Nouveau
Bonjour à tous ceux qui veulent bien m'aider :)
Je suis nouvelle sur le forum et débute en VBA que j'utilise dans mon stage pour faire de la cartographie.
Mon programme est censé extraire des adresses de contacts pour aller les coller dans un autre classeur excel existant.
Ce code fonctionnait très bien sur excel 2007. J'ai l'impression que depuis que je suis sous 2010 en version d'essai ça ne fonctionne plus. En plus, lorsqu'il est exécuté par un autre ordinateur en 2007, ça ne marche pas non plus.

J'ai essayé de chercher le problème est je crois que l'affectation des fichiers et l'utilisation des Wbk1 et 2 n'est pas reconnue.
Les deux fichiers se trouvent sur un serveur pour être accessibles par tous les employés.

Voila le code:
Sub Cartographie()

Dim lien As String
Dim feuill As String

On Error Resume Next

Application.ScreenUpdating = False

' Copie des adresses ayant un statut specifique dans l'onglet cartographie

k = 4
For x = 136 To 1000
If Sheets("Contacts").Cells(x, 8) = "Attente retour prediag" Or Sheets("Contacts").Cells(x, 8) = "Attente retour questionnaire" Or Sheets("Contacts").Cells(x, 8) = "Prediag en cours" Or Sheets("Contacts").Cells(x, 8) = "Devis envoyé" Or Sheets("Contacts").Cells(x, 8) = "Devis demandé" Or Sheets("Contacts").Cells(x, 8) = "GAGNE !!" Then

' ouverture du lien hypertexte
Sheets("Contacts").Cells(x, 1).Select
lien = Selection.Hyperlinks(1).SubAddress
feuill = Mid(lien, 2, InStr(lien, "!") - 3)
Sheets(feuill).Activate

' Copie du nom, de l'adresse, code postal et ville

Sheets("Cartographie").Cells(k, 1) = Sheets(feuill).Cells(9, 2) 'copie société
Sheets("Cartographie").Cells(k, 2) = Sheets(feuill).Cells(11, 2) ' copie contact
Sheets("Cartographie").Cells(k, 3) = Sheets(feuill).Cells(16, 2) 'copie rue
Sheets("Cartographie").Cells(k, 4) = Sheets(feuill).Cells(17, 2) ' copie code postal
Sheets("Cartographie").Cells(k, 5) = Sheets(feuill).Cells(18, 2) ' copie ville

Sheets("Contacts").Activate
Sheets("Cartographie").Cells(k, 6) = Sheets("Contacts").Cells(x, 8) 'copie du statut
k = k + 1

End If
Next

' Suppression des doublons
' Attention nombre de contacts limité a 1000 et 5 colonnes
Sheets("Cartographie").Range("$A$4:$F$1000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlNo
------> Jusque ici tout fonctionne ( donc travaille que sur un classeur)
'Suppression des lignes ou il n'y a pas d'adresse
j = 5
Set Wbk1 = ThisWorkbook
While Wbk1.Sheets("Cartographie").Cells(j, 2) <> Empty
If Wbk1.Sheets("Cartographie").Cells(j, 5) = "" Then
Sheets("Cartographie").Cells(j, 2).EntireRow.Delete
End If
j = j + 1
Wend

' Copie des adresses de cartographie dans le convertisseur GE

Set Wbk2 = Workbooks.Open("\\adresse du serveur\public\Creation_cartographie.xls")
Application.ActiveProtectedViewWindow.Edit
Wbk1.Sheets("Cartographie").Activate
Wbk2.Sheets("Data").Activate

' Remplissage de la colonne Nom du convertisseur
l = 5
j = 2
Dim Societe As String
Dim Nomcontact As String
While Wbk1.Sheets("Cartographie").Cells(l, 2) <> ""
Societe = Wbk1.Sheets("Cartographie").Cells(l, 1)
Nomcontact = Wbk1.Sheets("Cartographie").Cells(l, 2)
Wbk2.Sheets("Data").Cells(j, 1) = Societe & " " & Nomcontact
l = l + 1
j = j + 1
Wend

End sub
Je fais d'autres choses après mais c'est le début qui ne marche pas.
A mon avis c'est l'appel et l'assignation des fichiers a Wbk1 et Wbk2 qui ne marche pas ...
Avez vous des idées ou trouvez vous des erreurs, car je desespère un peu ..

Merci beaucoup d'avance !!!! :)
 

Vannillaa

XLDnaute Nouveau
Re : Programme qui marchait, ne fonctionne plus HELP !!!!

Du coup, ça bug déjà à l'ouverture du lien hypertexte ...
Erreur '9', l'indice n'appartient pas a la selection lorsque je fais lien=
La manoeuvre étant de récuperer le nom de la feuille masquée vers laquelle pointe le lien hypertexte..
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 196
Messages
2 086 100
Membres
103 116
dernier inscrit
kutobi87