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 ?

Salut liod,

Tu peux m'envoyer ton fichier excel ?

Voici le fichier merci de ton aide

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

Rechercher des sujets similaires à "probleme finalisation macro"