Erreur dans une macro que je n'identifie pas

Fermé

cooljuly44 - 30 mai 2016 à 15:44
cooljuly - 3 juin 2016 à 10:42

Bonjour,

j'ai un petit soucis avec ma macro. Elle se lance bien mais j'ai un soucis lors de la copie car elle ne copie pas les lignes que je désire.

c'est une macro qui sert à copier toutes les lignes des autres fichiers (a partir de la ligne 1) dans le fichier conso (à partir de D1)
mais avant de copier, elle doit vérifier que les lignes 1 de tous les fichiers correspondent bien à la ligne 1 de conso. Si c'est pas le cas, elle doit noter le nom du fichier en erreur dans l'onglet approprié.

mon soucis c'est qu'elle copie les titres de la ligne 1 et ne copie pas à partir de D1 (j'aurais une rechercheV dans les colonnes A B C après)

le fichier conso avec la macro : http://www.cjoint.com/c/FEEnQqDcicw
un exemple de fichier bon :http://www.cjoint.com/c/FEEnRfrOdjw
et un en erreur : http://www.cjoint.com/c/FEEnRZWC42w

si quelqu'un peut éclairer ma lanterne :)

merci par avance

A voir également:

Erreur dans une macro que je n'identifie pas
Erreur 0x80070643 - Guide
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Macro recorder - Télécharger - Confidentialité

3 réponses

Réponse 1 / 3

cooljuly
1 juin 2016 à 17:38

bonjour, je viens de changer des choses dans mon code et je n'ai toujours pas le résultat escompté. je dois faire une erreur bête mais je n'arrive pas à l'identifier même avec le pas à pas

Sub synthèseClasseurs()
'
'determination des variables
Dim ClassImp As String
Dim wImp As Workbook, wRecap As Workbook
Dim fImp As Worksheet
Dim derlignRec As Long, derlignImp As Long
Dim Repertoire As String
Dim dImp As Object
Dim tRec(), tImp()
Dim i As Variant, j As Variant
Dim N As Name

'--- Limitation des applications.
Application.ScreenUpdating = False

'Set maitre = ActiveWorkbook
Set wRecap = ThisWorkbook
Repertoire = ThisWorkbook.Path
derlignRec = fRec.Cells.Find("*", , , , xlByRows, xlPrevious).Row
ClassImp = Dir(Repertoire & "\*.xls*") ' premier fichier
tRec = fRec.Range("D1:S1")

'--- On boucle les fichiers.
Set dImp = CreateObject("Scripting.Dictionary")
Do While ClassImp <> "" ' Pour chaque fichier
If ClassImp <> ThisWorkbook.Name Then
'- On ouvre le fichier.
Set wImp = Workbooks.Open(Filename:=Repertoire & "\" & ClassImp, UpdateLinks:=2)
derlignImp = 0
Set wImp = ActiveWorkbook: Set fImp = ActiveSheet
For Each N In ActiveWorkbook.Names: N.Delete: Next
With fImp
'- On véfie la ligne 1
tImp = .Range("A1:P1")
For i = LBound(tRec) To UBound(tRec)
If tRec(i, 1) <> tImp(i, 1) Then dImp(wImp.Name) = "": GoTo Suite
Next i
' on enregistre la dernière ligne
derlignImp = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
'on copie les lignes
.Range(Cells(2, 1), Cells(derlignImp)).Copy fRec.Cells(derlignRec, 4)
End With
Suite:
wImp.Close False
End If
ClassImp = Dir ' fichier suivant
'on recalcule la dernière ligne importé
derlignRec = fRec.Cells.Find("*", , , , xlByRows, xlPrevious).Row
Loop

'--- Limitation des applications.
Application.ScreenUpdating = True

'--- On affiche la liste des fichiers non importés dans la feuille "Fichiers en erreur"
Sheets("Fichiers en erreur").Select
Range("A1").Select
ActiveCell.Value = "Nom du fichier en erreur"
For Each j In dImp.Keys
' Mess = Mess & j & Chr(13)
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
ActiveCell.Value = j
Next j

'Call calculs

End Sub

quelqu'un voit ce qui cloche ?
merci par avance

Réponse 2 / 3

thev Messages postés 1851 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 15 avril 2024 681
1 juin 2016 à 20:03

Bonjour,

j'effectuerai cette modification


    ' on enregistre la dernière ligne
            derlignImp = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            dercolnImp = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column

    'on copie les lignes
            .Range(Cells(2, 1), Cells(derlignImp, dercolnImp)).Copy fRec.Cells(derlignRec, 4)

cooljuly
2 juin 2016 à 10:50

effectivement cela fonctionne bien mieux avec ton code.
j'ai juste rajouté le +1

'on copie les lignes
.Range(Cells(2, 1), Cells(derlignImp, dercolnImp)).Copy fRec.Cells(derlignRec +1, 4)

il me reste plus que la vérification de la ligne 1 qui ne fonctionne pas.

merci Thev

thev Messages postés 1851 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 15 avril 2024 681 > cooljuly
2 juin 2016 à 11:26

Je regarde ce soir.

Réponse 3 / 3

thev Messages postés 1851 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 15 avril 2024 681
2 juin 2016 à 22:18

modification à effectuer

        
 '- On véfie la ligne 1
            tImp = .Range("A1:P1")
            For i = LBound(tRec, 2) To UBound(tRec, 2)
                If tRec(1, i) <> tImp(1, i) Then dImp(wImp.Name) = "": GoTo Suite

amélioration proposée

        
'--- On affiche la liste des fichiers non importés dans la feuille "Fichiers en erreur"
Sheets("Fichiers en erreur").Select
Range("A1").Value = "Nom du fichier en erreur"
Range("A1").Offset(1).Resize(dImp.Count).Value = Application.Transpose(dImp.Keys)

cooljuly
3 juin 2016 à 10:42

c'est parfait. je peux me lancer dans mes consolidations et reporting. Un grand merci à toi Thev.

Discussions similaires

Instagram "Désolé, une erreur s'est produite"

Erreur vidéo inconnue sur le Freebox Player

Free erreur 38 : impossible d'envoyer des SMS

Erreur de lecture sur iptv smarters

GWXUX a cessé de fonctionner

Discussions similaires

Newsletters