Problème de finalisation d'une macro
Bonjour à tous !
J'ai fais une petite macro qui copie des éléments d'un tableau vers un autre. Au début cette macro fonctionnait très bien quand elle copiait et collait que 6 éléments avec le code
Dim PasteData(6, 1)
depuis que j'ai étendu à plusieurs 13 éléments à copier coller ça fonctionne plus c'est assez curieux....
Pourriez-vous m'aider s'il vous plaît
Merci d'avance.
Voici la macro complète :
Sub ExportParticipation()
'Variables
'Compteur
Dim i As Double
'Adresse
Dim RowBase As String
Dim LastRowBase As Double 'Dernière Ligne utilisé du classeur "Base"
Dim SheetNameBase As String 'Nom de la feuille de travail sur le classeur "Base"
Dim SheetNamePart As String 'Nom d ela feuille de travail sur le classeur "Participation Majeurs"
Dim WkbNameBase As String 'Nom du Classeur "Base"
Dim WkbNamePart As String 'Nom du Classeur "Participation Majeur"
Dim AddressPaste As String
'Tableau
Dim ArrayDataBase As Variant 'Tableau répertoriant les Données du classeur "Base" (Colonne A)
Dim PasteData(13, 1) As Variant
'Divers
Dim FolderFound As Boolean
'Saisie du Dossier par l'utilisateur
On Error Resume Next
RowBase = InputBox("Quel dossier numéro de dossier voulez-vous traiter?", "Saisie du dossier")
If RowBase = 0 Then Exit Sub
On Error GoTo 0
'Variables à modifier en fonction de tes nom de classeur/Feuille
SheetNameBase = "Feuil1"
SheetNamePart = "PARTICIPATIONAAH-AAL"
WkbNameBase = "Base.xlsx"
WkbNamePart = "Participation majeur.xls"
'Chargement des Données de la feuille "Base"
LastRowBase = Workbooks(WkbNameBase).Sheets(SheetNameBase).Cells(1, 1).SpecialCells(xlLastCell).Row
ArrayDataBase = Workbooks(WkbNameBase).Sheets(SheetNameBase).Range(Workbooks(WkbNameBase).Sheets(SheetNameBase).Cells(1, 1), _
Workbooks(WkbNameBase).Sheets(SheetNameBase).Cells(LastRowBase, 1))
'Cherche le la ligne correspondant au numéro de dossier saisie
FolderFound = False
For i = 1 To LastRowBase
If CStr(ArrayDataBase(i, 1)) = CStr(RowBase) Then
RowBase = i
FolderFound = True
Exit For
End If
Next i
'Vérifie que le dossier a bien été trouvé
If FolderFound = False Then
MsgBox "Erreur : le dossier saisie n'a pas été trouvé.", Title:="Opération annulé"
Exit Sub
End If
'Copie les données
PasteData(1, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("B30")
PasteData(2, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("B37")
PasteData(3, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("B36")
PasteData(4, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("C7")
PasteData(5, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("C12")
PasteData(6, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F34")
PasteData(7, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F35")
PasteData(8, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F36")
PasteData(9, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F37")
PasteData(10, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F38")
PasteData(11, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F39")
PasteData(12, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F40")
PasteData(13, 1) = Workbooks(WkbNamePart).Sheets(SheetNamePart).Range("F41")
'Collage des données
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("AK" & RowBase) = PasteData(1, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("AM" & RowBase) = PasteData(2, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("AN" & RowBase) = PasteData(3, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("CO" & RowBase) = PasteData(4, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("CD" & RowBase) = PasteData(5, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("AW" & RowBase) = PasteData(6, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("BC" & RowBase) = PasteData(7, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("BE" & RowBase) = PasteData(8, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("AZ" & RowBase) = PasteData(9, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("AY" & RowBase) = PasteData(10, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("BD" & RowBase) = PasteData(11, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("BB" & RowBase) = PasteData(12, 1)
Workbooks(WkbNameBase).Sheets(SheetNameBase).Range("AV" & RowBase) = PasteData(13, 1)
Call Save
ActiveWorkbook.Close False 'ferme le fichier
Salut liod,
Tu peux m'envoyer ton fichier excel ?
bonjour,
le code est protégé par un mot de passe.
bonjour,
le code est protégé par un mot de passe.
Ah oui désolé voici le fichier sans mot de passe
Je crois qu'il faut que tu m'envoies un deuxième fichier qui doit d'appeler base.xlsx, en tout cas ça doit être un xlsx.
Je crois qu'il faut que tu m'envoies un deuxième fichier qui doit d'appeler base.xlsx, en tout cas ça doit être un xlsx.
C'est obligé car le fichier est très lourd je ne pense pas qu'il va rentrer ici... Après je ne comprends vraiment pas pourquoi ça fonctionne pas les colonnes correspondent bien...
bonjour,
quand tu dis que cela ne fonctionne pas, qu'est-ce que cela veut dire ?
reçois-tu un message d'erreur ?
les données ne sont pas copiées ou mal copiées ?
autre chose ... ?
eclaire-nous sur ce qui ne va pas , car sans les fichiers qui vont bien même ma boule de cristal a du mal.
pour ton info dans le fichier que tu as mis, les données de F35 à F40 sont vides, donc rien n'est copié pour ces cellules.
edit : je vois que AMO a fait le même constat que moi.
tu as vu que les valeurs que tu arrives pas à copier sont vides ? si tu mets la valeur X par exemple pour :
PCH
ASI
RSA de base ou majorée
ALS ou APL
ASPA ou les allocations constitutives de minimum vieillesse
APA
Aucune prestations sociales
ça marche non ?
bonjour,
quand tu dis que cela ne fonctionne pas, qu'est-ce que cela veut dire ?
reçois-tu un message d'erreur ?
les données ne sont pas copiées ou mal copiées ?
autre chose ... ?
eclaire-nous sur ce qui ne va pas , car sans les fichiers qui vont bien même ma boule de cristal a du mal.
pour ton info dans le fichier que tu as mis, les données de F35 à F40 sont vides, donc rien n'est copié pour ces cellules.
edit : je vois que AMO a fait le même constat que moi.
En faite oui plus rien ne fonctionne . Pas de message d'erreur non plus . Donc il faut obligatoirement remplir des informations dans les colonne de F35 à F40. Le but de cet macro est justement de sauter quand y'a rien dans les celulles... Je vais essayer en mettant des X dans les cellules.
Bonjour,
je te confirme que ta macro fonctionne correctement, en tout cas avec le fichier "base.xlsx" que je me suis créé puisque tu ne voulais pas nous fournir le tien.
Bonjour,
je te confirme que ta macro fonctionne correctement, en tout cas avec le fichier "base.xlsx" que je me suis créé puisque tu ne voulais pas nous fournir le tien.
Oui effectivement elle fonctionne bien! En faite quand j'ai envie que la macro ne copie pas des éléments des entre F34 et F40. Il faut que je mentionne "0".
Merci beaucoup de votre aide ça m'a appris à corriger mon problème