Problème dans ma boucle

Le 19/12/2017 à 10:32

Bonjour, je cherche a faire un programme suivant :

  • à partir d'un tableau remplie manuellement (doc Wk4), je veux remplir une "fiche matériel", par un système de copier/coller, à partir d'une fiche vierge se trouve sur un autre document Excel Wk2.
  • une ligne de mon tableau (Wk4) correspond à une fiche matériel
  • il y a autant de fiche matériel créé qu'il y a de ligne dans le tableau (Wk4)
  • les fiches matériels complétés sont créées dans un 3ème document Excel Wk3
  • dans le document Wk3 il y a nouvelle feuille créée qu'il y a de fiche matériel créée.

les noms des fichiers dans ma macro

Wk1 fichier où il y a la macro

Wk2 fichier où il y a la "fiche matériel vierge" (vide)

Wk3 fichier où toutes les "fiches matériels" seront créées et regrouper dans le principe de 1 feuille = 1 fiche matériel

Wk4 fichier où il y a le tableau où sont indiqués les informations. C'est le fichier "source" où on prend les renseignements des matériels que l'on transfère dans les fiches matériels (1 ligne du tableau = 1 fiche matériel)

Ma macro semble bien fonctionner elle arrive a créer autant de nouvelle feuille dans Wk3 qu'il y a de ligne dans le tableau, aucun message d'erreur ne s'affiche, cependant les fiches matériels créés sont vides..

Je pense donc avoir un problème lors de ma boucle créée à la ligne 83.

CODE

Sub macro_fiche_matériel()

j vaut 12

dernligneWk4 vaut 9 (c'est le bon nombre)

En gras c'est où je pense avoir l'erreur

S'il vous pouvez m'aider à résoudre ce problème ça commence à faire un petit moment que je me casse la tête dessus

Le 19/12/2017 à 11:06

Bonjour,

ne disposant pas de tes fichiers, difficile de se faire une idée précise du problème.

je remarque cependant quelque chose qui ne me parait pas correct tu écris tes données sur la feuille sheets(i), qui à mon avis ne correspond jamais à la feuille que tu viens d'ajouter.

i prend les valeurs de 1 à dernligneWk4

tu ajoutes une feuille à la fin de ton classeur (xllast), ce classeur ne se trouve pas en position i, et donc à mon avis tes données sont bien écrites mais pas là où tu penses...

Le 19/12/2017 à 11:13

Bonjour effectivement mon erreur vient de là je pense..

Mais je n'arrive pas a trouver la solution pour copier les valeurs dans les différentes feuilles...

J'ai mis en pièce jointe les fichiers

"fiche matériel tbl" correspond à Wk4 dans ma macro

5fiche-materiel-tbl.xlsx (497.00 Ko)
3macro-4-fiche-materiel.xlsm (24.23 Ko)
7wk2-fiche-vierge.xlsx (146.55 Ko)
5wk3-fiche-materiels-finales.xlsx (6.92 Ko)
Le 19/12/2017 à 11:24

Bonjour,

j'ai corrigé le problème que j'ai mentionné ci-avant

Sub macro_fiche_matériel()
'
' macro_fiche_matériel Macro

Dim Wk1 As Workbook 'doc où il y a la macro'
Dim Wk2 As Workbook 'doc fiches matériel vierge'
Dim Wk3 As Workbook 'doc fiches matériel complète'
Dim Wk4 As Workbook 'doc où il y a le tbl de données'
Dim fiche_vierge As String
Dim fiche_complete As String
Dim tableau As String

'lecture des chemins et ouverture des différents fichiers'
Set Wk1 = ThisWorkbook
    fiche_vierge = Wk1.Sheets(1).Range("E3")
    fiche_complete = Wk1.Sheets(1).Range("E4")
    tableau = Wk1.Sheets(1).Range("E5")

Set Wk2 = Workbooks.Open(fiche_vierge)
Set Wk3 = Workbooks.Open(fiche_complete)
Set Wk4 = Workbooks.Open(tableau)

'principe du copier/coller par lecture de nom de colonne, Wk4 --> Wk2'
Dim code_site As Range
Dim nom_site_ As Range
Dim adresse As Range
Dim localisation As Range
Dim code_equipement As Range
Dim denomination As Range
Dim xxx As Range 'ca correcpond au type'
Dim description As Range
Dim marque As Range
Dim caracteristiqueS As Range
Dim reference As Range
Dim etat As Range
Dim date_mise_service As Range
Dim caracteristique As Range
Dim alimentation_elec As Range
Dim regulation As Range
Dim int_phase_pompe1 As Range
Dim int_phase_pompe2 As Range
Dim int_phase_pompe3 As Range
Dim int_phase_chaudiere1 As Range
Dim int_phase_chaudiere2 As Range
Dim int_phase_chaudiere3 As Range
Dim pression_foyer_chaudiere As Range
Dim pression_amont_aval_gaz As Range
Dim pression_vase_expension As Range
Dim wso As Object

With Wk4.Sheets("info fiche matériel").Cells
    Set code_site = .Find(what:="code site")
    Set nom_site = .Find(what:="nom site")
    Set adresse = .Find(what:="Adresse")
    Set localisation = .Find(what:="Localisation")
    Set code_equipement = .Find(what:="code équipement")
    Set denomination = .Find(what:="dénomination")
    Set xxx = .Find(what:="type")
    Set description = .Find(what:="Description")
    Set marque = .Find(what:="marque")
    Set caracteristiqueS = .Find(what:="CARACTERISTIQUE")
    Set reference = .Find(what:="référence")
    Set etat = .Find(what:="état")
    Set date_mise_service = .Find(what:="date_mise_service")
    Set caracteristique = .Find(what:="Caractéristique")
    Set alimentation_elec = .Find(what:="Alimentation_elec")
    Set regulation = .Find(what:="régulation")
    Set int_phase_pompe1 = .Find(what:="Intensité par phase pompe1")
    Set int_phase_pompe2 = .Find(what:="Intensité par phase pompe2")
    Set int_phase_pompe3 = .Find(what:="Intensité par phase pompe3")
    Set int_phase_chaudiere1 = .Find(what:="Intensité par phase chaudière1")
    Set int_phase_chaudiere2 = .Find(what:="Intensité par phase chaudière2")
    Set int_phase_chaudiere3 = .Find(what:="Intensité par phase chaudière3")
    Set pression_foyer_chaudiere = .Find(what:="Pression du foyer chaudière")
    Set pression_amont_aval_gaz = .Find(what:="Pression amont/aval gaz")
    Set pression_vase_expension = .Find(what:="Pression à vide du vase d'expansion")
End With

Dim dernligneWk4 As String 'dernière ligne complétée de la colonne A du tbl'
Dim j As Integer 'permet de déterminer la dernière ligne'

j = 1
    While Wk4.Sheets("info fiche matériel").Cells(j, 1) <> ""
    j = j + 1
    Wend
    dernligneWk4 = j - 3

For i = 1 To dernligneWk4
Wk2.Sheets(1).Copy After:=Wk3.Sheets(Wk3.Sheets.Count)
Set wso = Wk3.Sheets(Wk3.Sheets.Count)
If Not code_site Is Nothing Then code_site.Offset(i).Copy
    wso.Range("B11").PasteSpecial Paste:=xlPasteValues
If Not nom_site Is Nothing Then nom_site.Offset(i).Copy
    wso.Range("A12").PasteSpecial Paste:=xlPasteValues
If Not adresse Is Nothing Then adresse.Offset(i).Copy
    wso.Range("A13").PasteSpecial Paste:=xlPasteValues
If Not localisation Is Nothing Then localisation.Offset(i).Copy
    wso.Range("A14").PasteSpecial Paste:=xlPasteValues
If Not code_equipement Is Nothing Then code_equipement.Offset(i).Copy
    wso.Range("B9").PasteSpecial Paste:=xlPasteValues
If Not denomination Is Nothing Then denomination.Offset(i).Copy wso.Range("C3").MergeArea
If Not xxx Is Nothing Then xxx.Offset(i).Copy
    wso.Range("B7").PasteSpecial Paste:=xlPasteValues
If Not description Is Nothing Then description.Offset(i).Copy
    wso.Range("B8").PasteSpecial Paste:=xlPasteValues
If Not marque Is Nothing Then marque.Offset(i).Copy
    wso.Range("B5").PasteSpecial Paste:=xlPasteValues
If Not caracteristiqueS Is Nothing Then caracteristiqueS.Offset(i).Copy
    wso.Range("B7").PasteSpecial Paste:=xlPasteValues
If Not reference Is Nothing Then reference.Offset(i).Copy
    wso.Range("B6").PasteSpecial Paste:=xlPasteValues
If Not etat Is Nothing Then etat.Offset(i).Copy wso.Range("B27").MergeArea
If Not date_mise_service Is Nothing Then date_mise_service.Offset(i).Copy wso.Range("B28").MergeArea
If Not caracteristique Is Nothing Then caracteristique.Offset(i).Copy
    wso.Range("A17").PasteSpecial Paste:=xlPasteValues
If Not alimentation_elec Is Nothing Then alimentation_elec.Offset(i).Copy
    wso.Range("B23").PasteSpecial Paste:=xlPasteValues
If Not regulation Is Nothing Then regulation.Offset(i).Copy wso.Range("B24").MergeArea
If Not int_phase_pompe1 Is Nothing Then int_phase_pompe1.Offset(i).Copy wso.Range("D32").MergeArea
If Not int_phase_pompe2 Is Nothing Then int_phase_pompe2.Offset(i).Copy wso.Range("D33").MergeArea
If Not int_phase_pompe3 Is Nothing Then int_phase_pompe3.Offset(i).Copy wso.Range("D34").MergeArea
If Not int_phase_chaudiere1 Is Nothing Then int_phase_chaudiere1.Offset(i).Copy wso.Range("D35").MergeArea
If Not int_phase_chaudiere2 Is Nothing Then int_phase_chaudiere2.Offset(i).Copy wso.Range("D36").MergeArea
If Not int_phase_chaudiere3 Is Nothing Then int_phase_chaudiere3.Offset(i).Copy wso.Range("D37").MergeArea
If Not pression_foyer_chaudiere Is Nothing Then pression_foyer_chaudiere.Offset(i).Copy wso.Range("D38").MergeArea
If Not pression_amont_aval_gaz Is Nothing Then pression_amont_aval_gaz.Offset(i).Copy wso.Range("D39").MergeArea
If Not pression_vase_expension Is Nothing Then pression_vase_expension.Offset(i).Copy wso.Range("D40").MergeArea

Next

Dim Client As String 'nom de client'
Dim jour As String 'date'
Dim chemin As String
Dim nomfichier As String

'ici on enregistre et on ferme'
    Client = Wk4.Sheets("info fiche matériel").Range("B1")
    jour = Wk1.Sheets(1).Range("A2")
    extension = ".xlsx"
    chemin = "C:\Users\stagiaires\Desktop\macro 4\"
    nomfichier = jour & "_Fiche matériel_" & Client & extension
Wk3.SaveCopyAs Filename:=chemin & nomfichier

Wk2.Close
Wk4.Close

End Sub
Le 19/12/2017 à 12:08

D'accord je comprends l'erreur merci beaucoup h2so4, ma macro fonctionne parfaitement !!

Rechercher des sujets similaires à "probleme boucle"