Discussion :

[kimou75]

Bonjour à tous,

Je reviens vers vous au sujet de ma macro. Le but est qu'elle fasse un vulgaire copier/coller de plusieurs feuilles vers une seule autre afin de concaténer l'ensemble.
En mode pas à pas, tout va bien. Cependant lorsque j’exécute ma macro, elle ne prend pas en compte l'ensemble des fichiers sources.

Du coup je me suis dit que cela pourrait provenir du fait que certaines taches sont plus longues que d'autres à exécuter, le copier/coller de milliers de lignes par exemple. Et donc j'ai mis une fonction pause de quelques secondes avant de passer à la taches suivantes mais le résultat est incorrecte. La 6eme feuille à copier se copie en ligne 2 au lieu de la ligne qui suit la dernière non vide.

Je n'arrive pas à trouver ce qui pourrait expliquer qu'en pas à pas, tout s'effectue correctement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub concatene()
Dim infolog, final As Workbook
 
Dim Nomfichier As String
Dim cpt, i As Double
 
dateJ = Date
dateYYYY = Right(dateJ, 4)
dateMM = Left(Right(dateJ, 7), 2)
dateDD = Left(dateJ, 2)
dateFic = dateYYYY & dateMM & dateDD
cpt = 1
 
 
Workbooks.Add
 
 
ActiveWorkbook.SaveAs Filename:= _
  "C:\Users\kguesmia\Documents\Alerte CASSE appro\Risque CASSE au " & dateFic & ".xlsx" _
  , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
 
Set final = Workbooks.Open(Filename:="C:\Users\kguesmia\Documents\Alerte CASSE appro\Risque CASSE au " & dateFic & ".xlsx")
 
Set infolog = Workbooks.Open(Filename:="C:\Users\kguesmia\Documents\Alerte CASSE appro\Donnees\Liste4_" & dateFic & " .xls")
Application.Wait Time + TimeSerial(0, 0, 3) 'attendre 3s
 
infolog.Sheets(1).UsedRange.Copy final.Sheets(1).Range("A" & cpt)
Application.Wait Time + TimeSerial(0, 0, 3)  'attendre 3s
 
cpt = final.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
 
i = 5
 Do While i <> 95
 
 Nomfichier = Dir("C:\Users\kguesmia\Documents\Alerte CASSE appro\Donnees\Liste" & i & "_" & dateFic & " .xls")
 
 If Nomfichier <> "" Then
  Set infolog = Workbooks.Open(Filename:="C:\Users\kguesmia\Documents\Alerte CASSE appro\Donnees\Liste" & i & "_" & dateFic & " .xls")
    Application.Wait Time + TimeSerial(0, 0, 3) 'attendre 3s
   ' Application.CutCopyMode = False:
    infolog.Sheets(1).Rows(1).Delete
    infolog.Sheets(1).UsedRange.Copy final.Sheets(1).Range("A" & cpt + 1)
    Application.Wait Time + TimeSerial(0, 0, 3)  'attendre 3s
    infolog.Sheets(1).UsedRange.Copy: Application.CutCopyMode = False
    infolog.Close SaveChanges:=False
cpt = final.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
End If
 
i = i + 1
 
Loop

[Oliv-]

Bonjour,
A première vue , rine qui semble justifier cette anomalie.

Ajoute un Doevents après tes Wait

[kimou75]

Oui je suis d'accord avec vous. A part la volumétrie des données à déplacer, je ne vois pas ce qui pose problème

Alors peut-être qu'en codant différemment, j'arriverai à optimiser cela.

[Oliv-]

Voici un exemple qui fonctionne en principe assez bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Public Sub FusionFichiers()
 
    Dim FichiersImport
    Dim ClasseurCourant As Workbook
    Dim IFichier As Integer
    Dim ClasseurImport As Workbook
    Dim FeuilleImport As Worksheet
    Dim ZoneCopie As Range, ZoneColle As Range
    Dim DerniereLigneRemplie
    Dim Nb_import As Integer
    Dim S As Worksheet
 
 
    Nb_import = 1
    Set ClasseurImport = Workbooks.Add
    Set FeuilleImport = ClasseurImport.Sheets.Add
    FeuilleImport.Name = "Import_" & Nb_import
    FeuilleImport.Cells.Clear
    FichiersImport = Application.GetOpenFilename("Fichiers Excel, *.xls; *.xlsx; *.xlsm", , "Sélectionnez les fichiers à importer", , True)
 
 
    Application.Calculation = xlCalculationManual
    For IFichier = LBound(FichiersImport) To UBound(FichiersImport)
        'Stop
 
        Set ClasseurCourant = Application.Workbooks.Open(FichiersImport(IFichier), , True)
        ClasseurCourant.Activate
        'Call sup_feuilles_vides
        For Each S In ClasseurCourant.Worksheets
 
                S.Activate
 
 
                If S.AutoFilterMode = True Then S.AutoFilterMode = False
                S.Cells.EntireColumn.Hidden = False
                S.Cells.EntireRow.Hidden = False
 
                Set DerniereLigneRemplie = FeuilleImport.Range("A1").SpecialCells(xlLastCell)
                Set ZoneColle = FeuilleImport.Range("A" & DerniereLigneRemplie.Row + DerniereLigneRemplie.Rows.Count)
 
                If ZoneColle.Address = "$A$2" Then Set ZoneColle = ZoneColle.Offset(-1, 0)
 
 
                Set ZoneCopie = S.Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
 
 
                On Error GoTo errorhandler
                ZoneCopie.Copy ZoneColle
                On Error GoTo 0
 
        Next S
 
 
        ClasseurCourant.Close SaveChanges:=False
 
    Next IFichier
    ClasseurImport.Activate
 
 
 
    Exit Sub
errorhandler:
    If Err = "1004" Then
        Nb_import = Nb_import + 1
Debug.Print Err
        If ZoneCopie.Rows.Count + ZoneColle.Row > Rows.Count Then
            MsgBox "trop de lignes"
            Set FeuilleImport = ClasseurImport.Sheets.Add
            FeuilleImport.Name = "Import_" & Nb_import
            Set ZoneColle = FeuilleImport.Range("A" & FeuilleImport.Range("A1").SpecialCells(xlLastCell).Row)
            Resume
        End If
    Else: MsgBox Err & vbCr & Err.Description
    End If
 
End Sub

[ZX12R]

Bonjour,

sans entrer dans le détail de ton problème...

L'instruction "Stop" permet de repasser en mode pas à pas.

Cordialement.

Bruno

[kimou75]

Superbe ton programme Oliv !! merci beaucoup.

Je vais tenter de le comprendre maintenant :-)