Formule VBA qui ne fonctionne pas au niveau de la recherche d'un fichier
Bonjour à tous.
Je suis nouveau sur le forum et dans le monde de la VBA également. J'ai décidé de me lancer dans son apprentissage à l'aide de bouquins, d'Internet et sur les conseils d'un collègue, de ChatGPT. J'ai décidé, pour mon boulot d'informatiser le process concernant le conditionnement des déchets. Je me suis attaqué à un gros projet, sur lequel j'ai bien avancé.
Je butte néanmoins sur une des macros. Je souhaite sélectionner les données d'un déchet primaire, dans une de mes feuilles, pour les ajouter dans un contenant secondaire (sous 2 conditions) précises. Une fois les valeurs copiées dans ma deuxième feuille, les valeurs dans la feuille source sont supprimées. La macro se poursuit en créant un dossier avec le NuméroFS du contenant, en allant chercher un fichier dans un dossier (des déchets primaires) pour le couper et le coller avec le même non dans le dossier des contenants crée juste avant. Malgré que le code me paraisse bon, que j'ai vérifié les chemins de dossier source ainsi que celui du dossier de destination (à créer), ainsi que les valeurs des cellules qui composent le nom de mon fichier, cela ne fonctionne pas: une fenêtre d'erreur s'ouvre et me dit que le fichier est introuvable.
J'espère que j'ai été assez clair. Ca fait trois jours que je suis dessus et je ne trouve toujours pas la cause de ce message d'erreur.
Sub CopierVersDossierEtCouperFichier()
Dim SourcePath As String
Dim DestinationPath As String
Dim NumeroFS As String
Dim NumeroChrono As String
Dim wsDestination As Worksheet
Dim wsDestinationName As String
Dim wsSource As Worksheet
Dim ligneSource As Range
Dim i As Integer
Dim condition1 As String
Dim condition2 As String
Dim derniereLigne As Long
Dim ligneTrouvee As Boolean
Dim nomFichier As String
' Spécifiez le nom de la feuille source
Set wsSource = ThisWorkbook.Worksheets("Inventaire total à conditionner")
' Spécifiez le nom de la feuille cible en utilisant la valeur de la cellule F1
wsDestinationName = wsSource.Range("F1").Value
' Vérifiez si la feuille source a été trouvée ou non
If wsSource Is Nothing Then
MsgBox "La feuille source 'Inventaire total à conditionner' n'a pas été trouvée.", vbExclamation
Exit Sub
End If
' Vérifiez si une ligne est sélectionnée
If Not wsSource.Application.Selection.Rows.Count = 1 Then
MsgBox "Sélectionnez une seule ligne dans la feuille 'Inventaire total à conditionner'.", vbExclamation
Exit Sub
End If
NumeroChrono = wsSource.Application.Selection.Cells(1, 3).Value
NumeroFS = wsSource.Range("H1").Value
nomFichier = NumeroChrono & " - F1"
' Vérifiez si la feuille de destination existe dans le classeur
On Error Resume Next
Set wsDestination = ThisWorkbook.Worksheets(wsDestinationName)
On Error GoTo 0
' Vérifiez si la feuille cible a été trouvée ou non
If wsDestination Is Nothing Then
MsgBox "La feuille '" & wsDestinationName & "' n'existe pas dans ce classeur.", vbExclamation
Exit Sub
End If
' Trouver la première ligne vide dans la feuille cible
derniereLigne = wsDestination.Cells(wsDestination.Rows.Count, 1).End(xlUp).Row
If derniereLigne > 1 Then
derniereLigne = derniereLigne + 1 ' Passer à la ligne vide suivante
End If
' Définir les conditions pour la copie
condition1 = wsSource.Range("J1").Value
condition2 = wsSource.Range("H2").Value
ligneTrouvee = False
For Each ligneSource In Selection.Rows
' Afficher le numéro de ligne dans des MsgBox (débogage)
MsgBox "Traitement de la ligne : " & ligneSource.Row
If ligneSource.Cells(1, 9).Value = condition1 And ligneSource.Cells(1, 12).Value = condition2 Then
' Copier les valeurs
For i = 1 To ligneSource.Columns.Count
wsDestination.Cells(derniereLigne, i).Value = ligneSource.Cells(1, i).Value
Next i
MsgBox "Les valeurs ont été ajoutées à '" & wsDestinationName & "'.", vbInformation
'Appeler le sous-macro CréerDossierEtCopierFichier
CréerDossierEtCopierFichier wsSource, ligneSource, NumeroChrono, NumeroFS, nomFichier, condition1, condition2
' Sortir de la boucle après avoir trouvé une ligne correspondante
Exit For
End If
Next ligneSource
If Not ligneTrouvee Then
MsgBox "Le déchet sélectionné n'a pas pu être ajouté à ce Big-Bag. La matrice ainsi que le spectre doivent concorder!", vbExclamation
End If
End Sub
Sub CréerDossierEtCopierFichier(ByVal wsSource As Worksheet, ByVal ligneSource As Range, ByVal NumeroChrono As String, ByVal NumeroFS As String, ByVal nomFichier As String, ByVal condition1 As String, ByVal condition2 As String)
Dim SourcePath As String
Dim DestinationPath As String
Dim FinalDestinationPath As String
' Déterminer les chemins
SourcePath = "C:\Users\AD764780\Déchets SEMSA\Déchets en Attente\"
DestinationPath = "C:\Users\AD764780\Desktop\Déchets SEMSA\Big-Bags\"
FinalDestinationPath = DestinationPath & NumeroFS
' Créer le dossier avec le nom contenu dans NumeroFS
If Dir(FinalDestinationPath, vbDirectory) = "" Then
' Le dossier n'existe pas, donc le créer
MkDir FinalDestinationPath
End If
' Copier le fichier vers le dossier cible
FileCopy SourcePath & nomFichier & ".xlsm", FinalDestinationPath
' Supprimer le fichier original
Kill SourcePath & nomFichier
End SubN.B: la valeur de la colonne C de ma ligne sélectionnée est 2023 -2, celle de la cellule H1 est S61564, mon SourcePath est "C:\Users\AD764780\Desktop\Déchets SEMSA\Déchets en attente", et mon Destination Path est " C:\Users\AD764780\Desktop\Déchets SEMSA\Big-Bags"
bonsoir,
sur quelle instruction reçois-tu le message d'erreur ?
je vois des erreurs sur ces instructions
' Copier le fichier vers le dossier cible
FileCopy SourcePath & nomFichier & ".xlsm", FinalDestinationPath
' Supprimer le fichier original
Kill SourcePath & nomFichierje verrais plutôt ceci
' Copier le fichier vers le dossier cible
FileCopy SourcePath & nomFichier & ".xlsm", FinalDestinationPath & nomFichier & ".xlsm"
' Supprimer le fichier original
Kill SourcePath & nomFichier & ".xlsm"ensuite
For Each ligneSource In Selection.Rowsje ne suis pas sûr de comprendre d'où vient cette sélection de lignes. Je n'imagine que la selection d'une seule ligne sur base de ces instructions.
' Vérifiez si une ligne est sélectionnée
If Not wsSource.Application.Selection.Rows.Count = 1 Then
MsgBox "Sélectionnez une seule ligne dans la feuille 'Inventaire total à conditionner'.", vbExclamation
Exit Sub
End Ifenfin
' Spécifiez le nom de la feuille cible en utilisant la valeur de la cellule F1
wsDestinationName = wsSource.Range("F1").Value
' Vérifiez si la feuille source a été trouvée ou non
If wsSource Is Nothing Then
MsgBox "La feuille source 'Inventaire total à conditionner' n'a pas été trouvée.", vbExclamation
Exit Sub
End Ifje verrais plutôt ceci
' Vérifiez si la feuille source a été trouvée ou non
If wsSource Is Nothing Then
MsgBox "La feuille source 'Inventaire total à conditionner' n'a pas été trouvée.", vbExclamation
Exit Sub
End If
' Spécifiez le nom de la feuille cible en utilisant la valeur de la cellule F1
wsDestinationName = wsSource.Range("F1").Valueet pour finir (pour commencer en fait !) , ce serait plus simple de t'aider avec un fichier dans lequel on peut reproduire ton problème.
Salut et merci d'avoir répondu.
et pour finir (pour commencer en fait !) , ce serait plus simple de t'aider avec un fichier dans lequel on peut reproduire ton problème.
Dois-je laisser une copie du fichier complet? Désolé je ne suis pas trop un habitué des forums.
sur quelle instruction reçois-tu le message d'erreur ?
je vois des erreurs sur ces instructions
' Copier le fichier vers le dossier cible
FileCopy SourcePath & nomFichier & ".xlsm", FinalDestinationPath
' Supprimer le fichier original
Kill SourcePath & nomFichier
C'est exactement cela. Lorsque j'exécute la formule, les données de ma feuille source s'incrémentent bien sur ma feuille de destination (Excel mouline d'ailleurs énormément à ce moment et je ne me l'explique pas
For Each ligneSource In Selection.Rows
J'ai du, pour trouver une solution à mon problème, explorer diverses pistes et ça doit être un vestige d'une des solutions envisagées à grand renfort de ChatGPT; ne trouvant pas moi-même la cause de l'erreur.
enfin
' Spécifiez le nom de la feuille cible en utilisant la valeur de la cellule F1
wsDestinationName = wsSource.Range("F1").Value
' Vérifiez si la feuille source a été trouvée ou non
If wsSource Is Nothing Then
MsgBox "La feuille source 'Inventaire total à conditionner' n'a pas été trouvée.", vbExclamation
Exit Sub
End If
je verrais plutôt ceci
' Vérifiez si la feuille source a été trouvée ou non
If wsSource Is Nothing Then
MsgBox "La feuille source 'Inventaire total à conditionner' n'a pas été trouvée.", vbExclamation
Exit Sub
End If
' Spécifiez le nom de la feuille cible en utilisant la valeur de la cellule F1
wsDestinationName = wsSource.Range("F1").Value
Cela a t-il une incidence? Je n'ai pas les connaissances suffisantes pour écrire une formule de façon "ordonnée". Y'a t-il un ordonnancement particulier à suivre pour optimiser une formule?
Encore merci pour ta réponse.
bonjour,
Je souhaite sélectionner les données d'un déchet primaire, dans une de mes feuilles, pour les ajouter dans un contenant secondaire (sous 2 conditions) précises. Une fois les valeurs copiées dans ma deuxième feuille, les valeurs dans la feuille source sont supprimées.
peux-tu fournir un fichier exemple avec ta feuille contenant des données d'un déchet primaire, et de ta (tes feuilles) "contenant secondaire" et expliquer comment doit se faire la copie des valeurs ?
La macro se poursuit en créant un dossier avec le NuméroFS du contenant, en allant chercher un fichier dans un dossier (des déchets primaires) pour le couper et le coller avec le même non dans le dossier des contenants crée juste avant.
Peux-tu reformuler ou/et illustrer par un dessin ce que tu cherches à faire ici, je ne vois pas trop le lien avec ce qui a été fait dans la première partie.
Je vous fait parvenir en mp le fichier complet. Merci du temps que vous passez à m'aider :)
Pour ceux qui débuteraient en VBA comme moi: mon erreur a été de ne pas spécifier l'extension des fichiers cherchés, par ailleurs, pensez à décocher l'option masquer l'extensions des fichiers sinon votre code vous laissera un message d'erreur. Merci pour les réponses qui ont conduit à me sortir de ce léger soucis.