IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Efiicience d'un code


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Mars 2011
    Messages
    316
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Contrôleur de Gestion
    Secteur : Enseignement

    Informations forums :
    Inscription : Mars 2011
    Messages : 316
    Par défaut Efiicience d'un code
    Bonjour,

    J'aimerais savoir si il est possible d'alléger le code suivant et de pouvoir accélerer la boucle


    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
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    545
    546
    547
    548
    549
    550
    551
    552
    553
    554
    555
    556
    557
    558
    559
    560
    561
    562
    563
    564
    565
    566
    567
    568
    569
    570
    571
    572
    573
    574
    575
    576
    577
    578
    579
    580
    581
    582
    583
    584
    585
    586
    587
    588
    589
    590
    591
    592
    593
    594
    595
    596
    597
    598
    599
    600
    601
    602
    603
    604
    605
    606
    607
    608
    609
    610
    611
    612
    613
    614
    615
    616
    617
    618
    619
    620
    621
    622
    623
    624
    625
    626
    627
    628
    629
    630
    631
    632
    633
    634
    635
    636
    637
    638
    639
    640
    641
    642
    643
    644
    645
    646
    647
    648
    649
    650
    651
    652
    653
    654
    655
    656
    657
    658
    659
    660
    661
    662
    663
    664
    665
    666
    667
    668
    669
    670
    671
    672
    673
    674
    675
    676
    677
    678
    679
    680
    681
    682
    683
    684
    685
    686
    687
    688
    689
    690
    691
    692
    693
    694
    695
    696
    697
    698
    699
    700
    701
    702
    703
    704
    705
    706
    707
    708
    709
    710
    711
    712
    713
    714
    715
    716
    717
    718
    719
    720
    721
    722
    723
    724
    725
    726
    727
    728
    729
    730
    731
    732
    733
    734
    735
    736
    737
    738
    739
    740
    741
    742
    743
    744
    745
    746
    747
    748
    749
    750
    751
    752
    753
    754
    755
    756
    757
    758
    759
    760
    761
    762
    763
    764
    765
    766
    767
    768
    769
    770
    771
    772
    773
    774
    775
    776
    777
    778
    779
    780
    781
    782
    783
    784
    785
    786
    787
    788
    789
    790
    791
    792
    793
    794
    795
    796
    797
    798
    799
    800
    801
    802
    803
    804
    805
    806
    807
    808
    809
    810
    Sub Calame()
     
     
    '***************************************************************************************************************************************
    Dim Wb As Workbook
    Dim rep As String
    Dim i&, j&, k&, l&, m&, n&, o&
    Dim MaPlage As Range, mc As Range, MaPlage1 As Range
    Dim Ws As Worksheet, Ws1 As Worksheet, Ws2 As Worksheet
    Dim Trouve As Boolean
     
    Set Ws = ThisWorkbook.Worksheets("CALAME")
    Set Ws1 = ThisWorkbook.Worksheets("Fichier Plat")
     
    Set MaPlage = Ws.Range("$k:$k")
    Set MaPlage1 = Ws1.Range("AD1:AD17000")
     
     
    Compteur = 0
    Compteura = 0
    Compteurb = 0
    Compteurc = 0
    Compteurd = 0
    Compteure = 0
    Compteurf = 0
    Compteurg = 0
    Compteurh = 0
    Compteuri = 0
    Compteurj = 0
    Compteurk = 0
    Compteurl = 0
    Compteurm = 0
    Compteurn = 0
    Compteur0 = 0
    Compteurp = 0
    Compteurq = 0
    Compteurr = 0
    Compteurs = 0
    Compteurt = 0
    Compteuru = 0
    Compteurv = 0
    Compteurw = 0
    Compteurx = 0
    Compteury = 0
    Compteurz = 0
    Compteuraa = 0
    Compteurab = 0
    Compteurac = 0
     
     
    '*****************************************************************************************************************************************
    ' On Error GoTo errorHandler
     
    '**************************************************************************************************************
     
    rep = InputBox("Par quel nom Commence le nom de votre fichier à importer?")
     
    '***************************************************************************************************************
    For Each Wb In Application.Workbooks
        If UCase(Wb.Name) Like UCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" _
        Or LCase(Wb.Name) Like LCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" Then
            Trouve = True
            Exit For
        End If
    Next Wb
     
    '****************************************************************************************************************
    Application.ScreenUpdating = False
    '****************************************************************************************************************
    If Trouve Then
     
        Set Ws2 = Wb.Worksheets("Contrats existants")
     
                     With Ws
                               If .AutoFilterMode Then
                              .Cells.AutoFilter
                                End If
     
                             .Range("A2:AN800").ClearContents
     
                    End With
     
     '***************************************
     '***************************************
     '***************************************
     '***************************************
     
                       With Ws1
                                If .AutoFilterMode Then
                              .Cells.AutoFilter
                                End If
     
     
                     l = Application.WorksheetFunction.Match("matériel ordures", MaPlage1, 0)
                    m = Application.WorksheetFunction.CountIf(MaPlage, "* - enlèvement ordures")
     
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                     l = Application.WorksheetFunction.Match("matériel nettoyage", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "* - nettoyage")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "loc longue durée - structure")
                                n = Application.WorksheetFunction.CountIf(MaPlage, "crédit bail - structure")
                        .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Contrat d' entretien général - Structure", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - structure")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
     
                         l = Application.WorksheetFunction.Match("Contrat d' entretien général - MG", MaPlage1, 0)
                             m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - MG")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                         l = Application.WorksheetFunction.Match("Contrat d' entretien général - Sec", MaPlage1, 0)
                             m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - sec")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                         l = Application.WorksheetFunction.Match("Contrat d' entretien général - Frais", MaPlage1, 0)
                             m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - frais")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                         l = Application.WorksheetFunction.Match("Contrat d' entretien général - Gel", MaPlage1, 0)
                             m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - gel")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                         l = Application.WorksheetFunction.Match("Contrat d' entretien général - Meca", MaPlage1, 0)
                             m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - système mécanisé")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     '*************************************************************************************************
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Terrain", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                         l = Application.WorksheetFunction.Match("Location matériel LD - MG", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - MG")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Sec", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - sec")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Frais", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - frais")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Gel", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - gel")
                                n = Application.WorksheetFunction.CountIf(MaPlage, "*préparation - gel")
                        .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Meca", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - système mécanisé")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Distri", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut distribution")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Contenant", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut contenant")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
     
     
                        l = Application.WorksheetFunction.Match("Location semi LD", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*semi distribution")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                      l = Application.WorksheetFunction.Match("Location semi frigo LD", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*semi frigo distribution")
                         .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Contrat d'entretien semis", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien semi - distribution")
                                n = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien matériel semi - distribution")
                        .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
     
     
     
     
                        l = Application.WorksheetFunction.Match("Contrat entret. semis frigo", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien semi frigo - distribution")
                                n = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien matériel semi frigo - distribution")
                        .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
     
     
     
                        l = Application.WorksheetFunction.Match("Location tracteur LD", MaPlage1, 0)
                            m = Application.WorksheetFunction.CountIf(MaPlage, "*tracteur distribution")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
     
                        l = Application.WorksheetFunction.Match("Contrat d'entretien tracteurs", MaPlage1, 0)
                                m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien matériel tracteur - distribution")
                        .Range("J" & l + 1 & ":L" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
     
     
     
                        l = Application.WorksheetFunction.Match("Contrat d' entretien général - Distribution", MaPlage1, 0)
                                m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - distribution")
                        .Range("J" & l + 1 & ":D" & l + m).Value = Null
                        .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
     
                       End With
     
     
     
     
     
     
                        With Ws2
     
                        .Activate
    '-------------------------------------------------------------------------------------------------------------------------------
    '********************************************************************************************************************************
    ' Choix de la plage à copier coller
    '-------------------------------------------------------------------------------------------------------------------------------
     
                            With Range("A2:AN800")
                             .Select
                             .Copy
                            End With
     
                     End With
     
         With Ws
                    .Activate
                    .Range("A2").PasteSpecial xlPasteValues
                                    Application.CutCopyMode = False
     
     
     
     
     
                     i = .Cells(Ws.Rows.Count, 1).End(xlUp).Row
     
     
    '******************************************************************************************************
    '**************************  LOCATION MATERIEL  *******************************************************
    '******************************************************************************************************
                     For j = 2 To i
     
                      With Ws
     
                      '******************************************************************************************************
                    '**************************  LOCATION MATERIEL ENLEVEMENT ORDURES  *******************************************************
                    '******************************************************************************************************
                    If .Range("K" & j) Like "* - enlèvement ordures" Then
     
     
     
                      With Ws1
     
                        l = Application.WorksheetFunction.Match("matériel ordures", MaPlage1, 0)
                        .Range("J" & l + Compteuraa).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteuraa).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteuraa).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteuraa).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteuraa).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteuraa).Value = Ws.Range("M" & j).Value
                        Compteuraa = Compteuraa + 1
                    End With
                     End If
     
                     '******************************************************************************************************
                    '**************************  LOCATION MATERIEL NETTOYAGE  *******************************************************
                    '******************************************************************************************************
                    If .Range("K" & j) Like "* - nettoyage" Then
     
     
                   With Ws1
     
                        l = Application.WorksheetFunction.Match("matériel nettoyage", MaPlage1, 0)
                        .Range("J" & l + Compteurab).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurab).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurab).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurab).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurab).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurab).Value = Ws.Range("M" & j).Value
                        Compteurab = Compteurab + 1
     
                End With
                     End If
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL STRUCTURE  *******************************************************
                    '******************************************************************************************************
                    If .Range("K" & j) = "loc longue durée - structure" Or .Range("K" & j) = "crédit bail - structure" Then
     
                  With Ws1
     
                        l = Application.WorksheetFunction.Match("Location matériel LD", MaPlage1, 0)
                        .Range("J" & l + Compteur).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteur).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteur).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteur).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteur).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteur).Value = Ws.Range("M" & j).Value
                        Compteur = Compteur + 1
     
                  End With
                     End If
     
     
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL EXPLOITATION - TERRAIN *************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*appareil manut terrain" Then
     
     
                     With Ws1
                        l = Application.WorksheetFunction.Match("Location matériel LD - Terrain", MaPlage1, 0)
                        .Range("J" & l + Compteurb).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurb).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurb).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurb).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurb).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurb).Value = Ws.Range("M" & j).Value
                        Compteurb = Compteurb + 1
                    End With
     
                    End If
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL EXPLOITATION - MG *************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*appareil manut terrain - MG" Then
     
     
                    With Ws1
                        l = Application.WorksheetFunction.Match("Location matériel LD - MG", MaPlage1, 0)
                        .Range("J" & l + Compteurx).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurx).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurx).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurx).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurx).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurx).Value = Ws.Range("M" & j).Value
                        Compteurx = Compteurx + 1
                    End With
     
                    End If
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL EXPLOITATION - SEC *************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*appareil manut terrain - sec" Then
     
     
                    With Ws1
                        l = Application.WorksheetFunction.Match("Location matériel LD - Sec", MaPlage1, 0)
                        .Range("J" & l + Compteuru).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteuru).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteuru).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteuru).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteuru).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteuru).Value = Ws.Range("M" & j).Value
                        Compteuru = Compteuru + 1
                    End With
     
                    End If
     
                      '******************************************************************************************************
                    '**************************  LOCATION MATERIEL EXPLOITATION - FRAIS *************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*appareil manut terrain - frais" Then
     
     
     
                     With Ws1
                        l = Application.WorksheetFunction.Match("Location matériel LD - Frais", MaPlage1, 0)
                        .Range("J" & l + Compteurm).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurm).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurm).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurm).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurm).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurm).Value = Ws.Range("M" & j).Value
                        Compteurm = Compteurm + 1
                    End With
     
     
                    End If
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL EXPLOITATION - GEL *************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*appareil manut terrain - gel" Or .Range("K" & j) Like "*préparation - gel" Then
     
                    With Ws1
                        l = Application.WorksheetFunction.Match("Location matériel LD - gel", MaPlage1, 0)
                        .Range("J" & l + Compteurn).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurn).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurn).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurn).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurn).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurn).Value = Ws.Range("M" & j).Value
                        Compteurn = Compteurn + 1
     
                    End With
     
                    End If
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL EXPLOITATION - SYSTEME MECANISE *************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*appareil manut terrain - système mécanisé" Then
     
     
                    With Ws1
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Meca", MaPlage1, 0)
                        .Range("J" & l + Compteurt).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurt).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurt).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurt).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurt).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurt).Value = Ws.Range("M" & j).Value
                        Compteurt = Compteurt + 1
     
                    End With
                    End If
     
                     '******************************************************************************************************
                    '**************************  LOCATION MATERIEL EXPLOITATION - DISTRIBUTION *************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*appareil manut distribution" Then
     
     
                     With Ws1
     
                        l = Application.WorksheetFunction.Match("Location matériel LD - Distri", MaPlage1, 0)
                        .Range("J" & l + Compteurz).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurz).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurz).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurz).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurz).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurz).Value = Ws.Range("M" & j).Value
                        Compteurz = Compteurz + 1
     
                     End With
                    End If
     
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL SEMIS  *******************************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*semi distribution" Then
     
                   With Ws1
                        l = Application.WorksheetFunction.Match("Location semi LD", MaPlage1, 0)
                        .Range("J" & l + Compteurc).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurc).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurc).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurc).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurc).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurc).Value = Ws.Range("M" & j).Value
                        Compteurc = Compteurc + 1
     
                   End With
                    End If
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL SEMIS FRIGOS  *******************************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*semi frigo distribution" Then
     
     
                    With Ws1
                        l = Application.WorksheetFunction.Match("Location semi frigo LD", MaPlage1, 0)
                        .Range("J" & l + Compteure).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteure).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteure).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteure).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteure).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteure).Value = Ws.Range("M" & j).Value
                        Compteure = Compteure + 1
                    End With
     
                    End If
     
                    '******************************************************************************************************
                    '**************************  LOCATION MATERIEL TRACTEURS  *******************************************************
                    '******************************************************************************************************
                     If .Range("K" & j) Like "*tracteur distribution" Then
     
     
                    With Ws1
                        l = Application.WorksheetFunction.Match("Location tracteur LD", MaPlage1, 0)
                        .Range("J" & l + Compteurd).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurd).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurd).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurd).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurd).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurd).Value = Ws.Range("M" & j).Value
                        Compteurd = Compteurd + 1
                    End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN GENERAL STRUCTURE  *******************************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien général - structure" Then
     
                    With Ws1
                         l = Application.WorksheetFunction.Match("Contrat d' entretien général - Structure", MaPlage1, 0)
                        .Range("J" & l + Compteura).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteura).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteura).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteura).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteura).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteura).Value = Ws.Range("M" & j).Value
                        Compteura = Compteura + 1
                   End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN GENERAL MG  ********************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien général - MG" Then
     
                   With Ws1
                       l = Application.WorksheetFunction.Match("Contrat d' entretien général- MG", MaPlage1, 0)
                        .Range("J" & l + Compteurw).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurw).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurw).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurw).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurw).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurw).Value = Ws.Range("M" & j).Value
                        Compteurw = Compteurw + 1
                    End With
     
                    End If
     
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN GENERAL SEC  *******************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien général - sec" Then
     
                      With Ws1
                         l = Application.WorksheetFunction.Match("Contrat d' entretien général - Sec", MaPlage1, 0)
                        .Range("J" & l + Compteurp).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurp).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurp).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurp).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurp).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurp).Value = Ws.Range("M" & j).Value
                        Compteurp = Compteurp + 1
                    End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN GENERAL FRAIS ******************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien général - frais" Then
     
                    With Ws1
     
                       l = Application.WorksheetFunction.Match("Contrat d' entretien général - Frais", MaPlage1, 0)
                        .Range("J" & l + Compteurq).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurq).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurq).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurq).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurq).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurq).Value = Ws.Range("M" & j).Value
                        Compteurq = Compteurq + 1
                   End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN GENERAL GEL ********************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien général - gel" Then
     
                   With Ws1
                       l = Application.WorksheetFunction.Match("Contrat d' entretien général - Gel", MaPlage1, 0)
                        .Range("J" & l + Compteurr).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurr).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurr).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurr).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurr).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurr).Value = Ws.Range("M" & j).Value
                        Compteurr = Compteurr + 1
                   End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN GENERAL MECA  *******************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien général - système mécanisé" Then
     
     
                       With Ws1
                       l = Application.WorksheetFunction.Match("Contrat d' entretien général - Meca", MaPlage1, 0)
                        .Range("J" & l + Compteurs).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurs).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurs).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurs).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurs).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurs).Value = Ws.Range("M" & j).Value
                        Compteurs = Compteurs + 1
                        End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN DISTRI  *******************************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien général - distribution" Then
     
                        With Ws1
                       l = Application.WorksheetFunction.Match("Contrat d' entretien", MaPlage1, 0)
                        .Range("J" & l + Compteurf).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurf).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurf).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurf).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurf).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurf).Value = Ws.Range("M" & j).Value
                        Compteurf = Compteurf + 1
                      End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN TRACTEUR  *******************************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien matériel tracteur - distribution" Then
     
                      With Ws1
                       l = Application.WorksheetFunction.Match("Contrat d'entretien tracteurs", MaPlage1, 0)
                        .Range("J" & l + Compteurg).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurg).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurg).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurg).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurg).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurg).Value = Ws.Range("M" & j).Value
                        Compteurg = Compteurg + 1
                    End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN SEMI  **************************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien semi - distribution" Or .Range("K" & j) = "contrat entretien matériel semi - distribution" Then
     
                      With Ws1
                       l = Application.WorksheetFunction.Match("Contrat d'entretien semis", MaPlage1, 0)
                        .Range("J" & l + Compteurh).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteurh).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteurh).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteurh).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteurh).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteurh).Value = Ws.Range("M" & j).Value
                        Compteurh = Compteurh + 1
                      End With
     
                    End If
     
    '******************************************************************************************************
    '**************************  CONTRAT ENTRETIEN SEMI FRIGO  ********************************************
    '******************************************************************************************************
     
     
                    If .Range("K" & j) = "contrat entretien semi frigo - distribution" Or .Range("K" & j) = "contrat entretien matériel semi frigo - distribution" Then
     
                      With Ws1
                       l = Application.WorksheetFunction.Match("Contrat entret. semis frigo", MaPlage1, 0)
                        .Range("J" & l + Compteuri).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteuri).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteuri).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteuri).Value = Ws.Range("R" & j).Value
                        .Range("AE" & l + Compteuri).Value = Ws.Range("Q" & j).Value
                        .Range("AF" & l + Compteuri).Value = Ws.Range("M" & j).Value
                        Compteuri = Compteuri + 1
                     End With
     
                    End If
     
              End With
     
     
                     Next j
     
     
    End With
     
     
     
    For Each Sh In Worksheets
     
            For Each pvt In Sh.PivotTables
                pvt.RefreshTable
            Next pvt
     
    Next Sh
     
     
     
    '*******************************************************
    '*******************************************************
    '*******************************************************
    End If
     
    Set Wb = Nothing
    Set Ws = Nothing
    Set Ws1 = Nothing
    Set Ws2 = Nothing
     
    Set MaPlage = Nothing
    Set MaPlage1 = Nothing
     
     
     
    'errorHandler:
     
     '   MsgBox "Erreur sur le code macro" & vbCrLf & _
      '      "Ou vous avez validé sans mettre de lettres" & vbCrLf & _
        '    "Veuillez informer le concepteur du code pour résolution"
    End Sub

    Je ne vous cache pas que le fait de le voir améliorer me permettra mieux appréhender la logique des codes
    Merci de votre contribution

  2. #2
    Membre éclairé
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Mars 2011
    Messages
    316
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Contrôleur de Gestion
    Secteur : Enseignement

    Informations forums :
    Inscription : Mars 2011
    Messages : 316
    Par défaut
    voici ce que j'ai pu améliorer mis tojours aussi long pour la mise à "null"

    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
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    Sub Calame()
     
     
    '***************************************************************************************************************************************
    Dim Wb As Workbook
    Dim rep As String
    Dim i&, j&, l&, k As Variant, m As Variant
    Dim MaPlage1 As Range, MaPlage2 As Range, MaPlage3 As Range
    Dim Ws As Worksheet, Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
    Dim Trouve As Boolean
     
    Set Ws = ThisWorkbook.Worksheets("CALAME")
    Set Ws1 = ThisWorkbook.Worksheets("Fichier Plat")
    Set Ws2 = ThisWorkbook.Worksheets("Table Synergie")
     
    Set MaPlage1 = Ws1.Range("AE1:AE8500")
    Set MaPlage2 = Ws2.Range("AH2:AH25")
    Set MaPlage3 = Ws2.Range("AG2:AH25")
     
     
    '*****************************************************************************************************************************************
     'On Error GoTo errorHandler
     
    '*****************************************************************************************************************************************
     
    rep = InputBox("Par quel nom Commence le nom de votre fichier à importer?")
     
    '***************************************************************************************************************
    For Each Wb In Application.Workbooks
        If UCase(Wb.Name) Like UCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" _
        Or LCase(Wb.Name) Like LCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" Then
            Trouve = True
            Exit For
        End If
    Next Wb
     
    '****************************************************************************************************************
    Application.ScreenUpdating = False
    'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
    If Trouve Then
     
     
    '****************************************************************************************************************
    Set Ws3 = Wb.Worksheets(2)
    '****************************************************************************************************************
     
     
         With Ws3
         i = .Cells(.Rows.Count, 1).End(xlUp).Row
     
    '****************************************************************************************************************
                        With Ws
                                        If .AutoFilterMode Then
                                       .Cells.AutoFilter
                                           End If
     
                                       .Range("A2:AN800").ClearContents
                         End With
    '****************************************************************************************************************
        .Activate
        .Range("K2:K" & i).Replace What:="crédit bail", Replacement:="loc longue durée", LookAt:=xlWhole
     
    '****************************************************************************************************************
                            With Range("A2:AN" & i)
                             .Select
                             .Copy
                                        With Ws
                                       .Activate
                                       .Range("A2").PasteSpecial xlPasteValues
                                               Application.CutCopyMode = False
                                        End With
                            End With
    '****************************************************************************************************************
    'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
     
                            With Ws1
                            For Each k In MaPlage2
     
                            On Error Resume Next
     
                                    l = Application.WorksheetFunction.Match(k, MaPlage1, 0)
     
                        .Range("J" & l & ":AB" & l + 49).Value = Null
                        .Range("AF" & l & ":AG" & l + 49).Value = Null
     
     
                            Next k
                        End With
    'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
     
    'cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     
            With Ws
     
     
     
     
                                    For Each k In MaPlage2
     
                                            Compteur = 0
     
                                            For j = 2 To i
     
                    If .Range("K" & j) = Application.WorksheetFunction.Index(MaPlage3, WorksheetFunction.Match(k, MaPlage2, 0), 1) Then
     
     
                      With Ws1
     
     
                        l = Application.WorksheetFunction.Match(k, MaPlage1, 0)
                        .Range("J" & l + Compteur).Value = Ws.Range("G" & j).Value
                        .Range("K" & l + Compteur).Value = Ws.Range("C" & j).Value
                        .Range("L" & l + Compteur).Value = Ws.Range("H" & j).Value
                        .Range("M" & l + Compteur).Value = Ws.Range("R" & j).Value
                        .Range("AF" & l + Compteur).Value = Ws.Range("Q" & j).Value
                        .Range("AG" & l + Compteur).Value = Ws.Range("M" & j).Value
                        Compteur = Compteur + 1
                        .Range("Q" & l).FormulaLocal = "=SI(ET(DATE(GAUCHE($Q$1;4);COLONNE(Q" & l & ")-16;1)>$AE" & l & ";DATE(GAUCHE($Q$1;4);COLONNE(Q" & l & ")-16;1)<$M" & l & ");$AF" & l & ";0)+SI($O" & l & ">$M" & l & ";SI(ET(DATE(GAUCHE($Q$1;4);COLONNE(Q" & l & ")-16;1)>$M" & l & ";DATE(GAUCHE($Q$1;4);COLONNE(Q" & l & ")-16;1)<$O" & l & ");$N" & l & ";0);0)"
                        .Range("Q" & l).Copy
                        .Range("Q" & l & ":AB" & l + 49).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                        SkipBlanks:=False, Transpose:=False
                      End With
                    End If
     
                                          Next j
     
                                    Next k
     
     
     
            End With
     
     
    'cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        End With
     
     
    End If
     
     
    'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
     
     
    Set Wb = Nothing
    Set Ws = Nothing
    Set Ws1 = Nothing
    Set Ws2 = Nothing
    Set Ws3 = Nothing
     
     
    Set MaPlage1 = Nothing
    Set MaPlage2 = Nothing
    Set MaPlage3 = Nothing
     
     
    'errorHandler:
     
       ' MsgBox "Erreur sur le code macro" & vbCrLf & _
           ' "Ou vous avez validé sans mettre de lettres" & vbCrLf & _
            '"Veuillez informer le concepteur du code pour résolution"
    End Sub

  3. #3
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 173
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 173
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    Pour pouvoir t'aider, ce serait plus simple que tu expliques en français ce que tu souhaites faire avec ton code parce-que sans le savoir, il est très compliqué de t'aider

    Les seules explications que tu nous donnes
    • "J'aimerais savoir si il est possible d'alléger le code suivant et de pouvoir accélerer la boucle"
      On s'attend à voir une boucle mais il y en a plusieurs et puis il y a d'autres lignes de codes.
    • "voici ce que j'ai pu améliorer mis tojours aussi long pour la mise à "null""
      La mise à "Null", cela ne me parle pas.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  4. #4
    Membre éclairé
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Mars 2011
    Messages
    316
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Contrôleur de Gestion
    Secteur : Enseignement

    Informations forums :
    Inscription : Mars 2011
    Messages : 316
    Par défaut
    bonjour Philippe,

    le code recupere les données d'un fichier et copie colle dans un onglet du fichier

    puis en fonction des diffèrents critères d'un champ copie/colle sur la ligne approprié du critère.

    mais avant que la boucle s'effectue, je fais la mise à blanc de ces mêmes cellules (diffèrents critères d'un champ) =>
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    For Each k In MaPlage2
     
                            On Error Resume Next
     
                                    l = Application.WorksheetFunction.Match(k, MaPlage1, 0)
     
                        .Range("J" & l & ":AB" & l + 49).Value = Null
                        .Range("AF" & l & ":AG" & l + 49).Value = Null
     
     
                            Next k


    Espérant avoir été clair

  5. #5
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 173
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 173
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    Si tu dois faire une recherche de chaque élément d'une plage, je ne vois pas comment éviter la boucle mais pourquoi as-tu besoin d'effacer les valeurs de cellules que tu vas de toutes manières remplir ensuite ?

    Même si cela ne vas pas augmenter la vitesse, je remplacerais .Range("J" & l & ":AB" & l + 49).Value = Null par .Range("J" & l & ":AB" & l + 49).ClearContents
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  6. #6
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    Tu devrais commencer par écrire ton code sans lignes vides ni commentaires polluants et surtout l'indenter correctement.
    C'est un joyeux bordel dans les With !
    D'autre part le On Error Resume Next n'est jamais annulé, il s'applique à tout le reste du code...

  7. #7
    Membre éclairé
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Mars 2011
    Messages
    316
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Contrôleur de Gestion
    Secteur : Enseignement

    Informations forums :
    Inscription : Mars 2011
    Messages : 316
    Par défaut
    Bonjour Philippe,

    Pour y répondre à :
    pourquoi as-tu besoin d'effacer les valeurs de cellules que tu vas de toutes manières remplir ensuite ?
    Parce que ce que je remplis ensuite n'est pas forcément > à la première fois donc en conséquence je n'ai pas écrasé la première version

  8. #8
    Membre éclairé
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Mars 2011
    Messages
    316
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Contrôleur de Gestion
    Secteur : Enseignement

    Informations forums :
    Inscription : Mars 2011
    Messages : 316
    Par défaut
    Bonjour Patrice,

    sans vouloir être autun
    Tu devrais commencer par écrire ton code sans lignes vides ni commentaires polluants et surtout l'indenter correctement
    , ca va changer quoi?

    pour indenter correctement, je ne connais pas ce terme technique

    Et merci pour le error resume next

  9. #9
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    Citation Envoyé par ALEX80800 Voir le message
    Bonjour Patrice,
    sans vouloir être autun , ca va changer quoi?
    pour indenter correctement, je ne connais pas ce terme technique
    Ça va changer que ton code sera beaucoup plus lisible et donc beaucoup moins de contributeurs seront rebutées par le déchiffrement.

    L’indentation consiste à introduire une ou plusieurs tabulations au début de certaines lignes d’un programme afin d’en améliorer la lisibilité.
    La finalité c'est la lisibilité, par exemple avec ton premier code, ça donnerait :
    Code VBA : 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
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    Sub Calame()
    Dim Wb As Workbook
    Dim rep As String
    Dim i&, j&, k&, l&, m&, n&, o&
    Dim MaPlage As Range, mc As Range, MaPlage1 As Range
    Dim Ws As Worksheet, Ws1 As Worksheet, Ws2 As Worksheet
    Dim Trouve As Boolean
     
      Set Ws = ThisWorkbook.Worksheets("CALAME")
      Set Ws1 = ThisWorkbook.Worksheets("Fichier Plat")
      Set MaPlage = Ws.Range("$k:$k")
      Set MaPlage1 = Ws1.Range("AD1:AD17000")
     
      Compteur = 0
      Compteura = 0
      Compteurb = 0
      Compteurc = 0
      Compteurd = 0
      Compteure = 0
      Compteurf = 0
      Compteurg = 0
      Compteurh = 0
      Compteuri = 0
      Compteurj = 0
      Compteurk = 0
      Compteurl = 0
      Compteurm = 0
      Compteurn = 0
      Compteur0 = 0
      Compteurp = 0
      Compteurq = 0
      Compteurr = 0
      Compteurs = 0
      Compteurt = 0
      Compteuru = 0
      Compteurv = 0
      Compteurw = 0
      Compteurx = 0
      Compteury = 0
      Compteurz = 0
      Compteuraa = 0
      Compteurab = 0
      Compteurac = 0
     
      rep = InputBox("Par quel nom Commence le nom de votre fichier à importer?")
      For Each Wb In Application.Workbooks
        If UCase(Wb.Name) Like UCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" _
            Or LCase(Wb.Name) Like LCase(Left(rep, 1)) & Mid(rep, 2, 40) & "*" Then
          Trouve = True
          Exit For
        End If
      Next Wb
     
      Application.ScreenUpdating = False
      If Trouve Then
        Set Ws2 = Wb.Worksheets("Contrats existants")
        With Ws
          If .AutoFilterMode Then
            .Cells.AutoFilter
          End If
          .Range("A2:AN800").ClearContents
        End With
     
        With Ws1
          If .AutoFilterMode Then
            .Cells.AutoFilter
          End If
          l = Application.WorksheetFunction.Match("matériel ordures", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "* - enlèvement ordures")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("matériel nettoyage", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "* - nettoyage")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "loc longue durée - structure")
          n = Application.WorksheetFunction.CountIf(MaPlage, "crédit bail - structure")
          .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d' entretien général - Structure", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - structure")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d' entretien général - MG", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - MG")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d' entretien général - Sec", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - sec")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d' entretien général - Frais", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - frais")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d' entretien général - Gel", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - gel")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d' entretien général - Meca", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - système mécanisé")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - Terrain", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - MG", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - MG")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - Sec", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - sec")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - Frais", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - frais")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - Gel", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - gel")
          n = Application.WorksheetFunction.CountIf(MaPlage, "*préparation - gel")
          .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - Meca", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut terrain - système mécanisé")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - Distri", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut distribution")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location matériel LD - Contenant", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*appareil manut contenant")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location semi LD", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*semi distribution")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Location semi frigo LD", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*semi frigo distribution")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d'entretien semis", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien semi - distribution")
          n = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien matériel semi - distribution")
          .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
          l = Application.WorksheetFunction.Match("Contrat entret. semis frigo", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien semi frigo - distribution")
          n = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien matériel semi frigo - distribution")
          .Range("J" & l + 1 & ":L" & l + m + n).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m + n).Value = Null
          l = Application.WorksheetFunction.Match("Location tracteur LD", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "*tracteur distribution")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d'entretien tracteurs", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien matériel tracteur - distribution")
          .Range("J" & l + 1 & ":L" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
          l = Application.WorksheetFunction.Match("Contrat d' entretien général - Distribution", MaPlage1, 0)
          m = Application.WorksheetFunction.CountIf(MaPlage, "contrat entretien général - distribution")
          .Range("J" & l + 1 & ":D" & l + m).Value = Null
          .Range("AF" & l + 1 & ":AG" & l + m).Value = Null
        End With
     
        With Ws2
          .Activate
          With Range("A2:AN800")
            .Select
            .Copy
          End With
        End With
     
        With Ws
          .Activate
          .Range("A2").PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          i = .Cells(Ws.Rows.Count, 1).End(xlUp).Row
          For j = 2 To i
            With Ws
              If .Range("K" & j) Like "* - enlèvement ordures" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("matériel ordures", MaPlage1, 0)
                  .Range("J" & l + Compteuraa).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteuraa).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteuraa).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteuraa).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteuraa).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteuraa).Value = Ws.Range("M" & j).Value
                  Compteuraa = Compteuraa + 1
                End With
              End If
              If .Range("K" & j) Like "* - nettoyage" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("matériel nettoyage", MaPlage1, 0)
                  .Range("J" & l + Compteurab).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurab).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurab).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurab).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurab).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurab).Value = Ws.Range("M" & j).Value
                  Compteurab = Compteurab + 1
                End With
              End If
              If .Range("K" & j) = "loc longue durée - structure" Or .Range("K" & j) = "crédit bail - structure" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD", MaPlage1, 0)
                  .Range("J" & l + Compteur).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteur).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteur).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteur).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteur).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteur).Value = Ws.Range("M" & j).Value
                  Compteur = Compteur + 1
                End With
              End If
              If .Range("K" & j) Like "*appareil manut terrain" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD - Terrain", MaPlage1, 0)
                  .Range("J" & l + Compteurb).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurb).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurb).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurb).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurb).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurb).Value = Ws.Range("M" & j).Value
                  Compteurb = Compteurb + 1
                End With
              End If
              If .Range("K" & j) Like "*appareil manut terrain - MG" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD - MG", MaPlage1, 0)
                  .Range("J" & l + Compteurx).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurx).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurx).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurx).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurx).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurx).Value = Ws.Range("M" & j).Value
                  Compteurx = Compteurx + 1
                End With
              End If
              If .Range("K" & j) Like "*appareil manut terrain - sec" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD - Sec", MaPlage1, 0)
                  .Range("J" & l + Compteuru).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteuru).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteuru).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteuru).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteuru).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteuru).Value = Ws.Range("M" & j).Value
                  Compteuru = Compteuru + 1
                End With
              End If
              If .Range("K" & j) Like "*appareil manut terrain - frais" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD - Frais", MaPlage1, 0)
                  .Range("J" & l + Compteurm).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurm).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurm).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurm).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurm).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurm).Value = Ws.Range("M" & j).Value
                  Compteurm = Compteurm + 1
                End With
              End If
              If .Range("K" & j) Like "*appareil manut terrain - gel" Or .Range("K" & j) Like "*préparation - gel" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD - gel", MaPlage1, 0)
                  .Range("J" & l + Compteurn).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurn).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurn).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurn).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurn).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurn).Value = Ws.Range("M" & j).Value
                  Compteurn = Compteurn + 1
                End With
              End If
              If .Range("K" & j) Like "*appareil manut terrain - système mécanisé" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD - Meca", MaPlage1, 0)
                  .Range("J" & l + Compteurt).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurt).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurt).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurt).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurt).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurt).Value = Ws.Range("M" & j).Value
                  Compteurt = Compteurt + 1
                End With
              End If
              If .Range("K" & j) Like "*appareil manut distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location matériel LD - Distri", MaPlage1, 0)
                  .Range("J" & l + Compteurz).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurz).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurz).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurz).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurz).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurz).Value = Ws.Range("M" & j).Value
                  Compteurz = Compteurz + 1
                End With
              End If
              If .Range("K" & j) Like "*semi distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location semi LD", MaPlage1, 0)
                  .Range("J" & l + Compteurc).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurc).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurc).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurc).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurc).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurc).Value = Ws.Range("M" & j).Value
                  Compteurc = Compteurc + 1
                End With
              End If
              If .Range("K" & j) Like "*semi frigo distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location semi frigo LD", MaPlage1, 0)
                  .Range("J" & l + Compteure).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteure).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteure).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteure).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteure).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteure).Value = Ws.Range("M" & j).Value
                  Compteure = Compteure + 1
                End With
              End If
              If .Range("K" & j) Like "*tracteur distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Location tracteur LD", MaPlage1, 0)
                  .Range("J" & l + Compteurd).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurd).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurd).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurd).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurd).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurd).Value = Ws.Range("M" & j).Value
                  Compteurd = Compteurd + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien général - structure" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d' entretien général - Structure", MaPlage1, 0)
                  .Range("J" & l + Compteura).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteura).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteura).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteura).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteura).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteura).Value = Ws.Range("M" & j).Value
                  Compteura = Compteura + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien général - MG" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d' entretien général- MG", MaPlage1, 0)
                  .Range("J" & l + Compteurw).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurw).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurw).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurw).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurw).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurw).Value = Ws.Range("M" & j).Value
                  Compteurw = Compteurw + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien général - sec" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d' entretien général - Sec", MaPlage1, 0)
                  .Range("J" & l + Compteurp).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurp).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurp).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurp).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurp).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurp).Value = Ws.Range("M" & j).Value
                  Compteurp = Compteurp + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien général - frais" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d' entretien général - Frais", MaPlage1, 0)
                  .Range("J" & l + Compteurq).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurq).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurq).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurq).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurq).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurq).Value = Ws.Range("M" & j).Value
                  Compteurq = Compteurq + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien général - gel" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d' entretien général - Gel", MaPlage1, 0)
                  .Range("J" & l + Compteurr).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurr).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurr).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurr).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurr).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurr).Value = Ws.Range("M" & j).Value
                  Compteurr = Compteurr + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien général - système mécanisé" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d' entretien général - Meca", MaPlage1, 0)
                  .Range("J" & l + Compteurs).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurs).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurs).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurs).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurs).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurs).Value = Ws.Range("M" & j).Value
                  Compteurs = Compteurs + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien général - distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d' entretien", MaPlage1, 0)
                  .Range("J" & l + Compteurf).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurf).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurf).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurf).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurf).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurf).Value = Ws.Range("M" & j).Value
                  Compteurf = Compteurf + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien matériel tracteur - distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d'entretien tracteurs", MaPlage1, 0)
                  .Range("J" & l + Compteurg).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurg).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurg).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurg).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurg).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurg).Value = Ws.Range("M" & j).Value
                  Compteurg = Compteurg + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien semi - distribution" Or .Range("K" & j) = "contrat entretien matériel semi - distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat d'entretien semis", MaPlage1, 0)
                  .Range("J" & l + Compteurh).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteurh).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteurh).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteurh).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteurh).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteurh).Value = Ws.Range("M" & j).Value
                  Compteurh = Compteurh + 1
                End With
              End If
              If .Range("K" & j) = "contrat entretien semi frigo - distribution" Or .Range("K" & j) = "contrat entretien matériel semi frigo - distribution" Then
                With Ws1
                  l = Application.WorksheetFunction.Match("Contrat entret. semis frigo", MaPlage1, 0)
                  .Range("J" & l + Compteuri).Value = Ws.Range("G" & j).Value
                  .Range("K" & l + Compteuri).Value = Ws.Range("C" & j).Value
                  .Range("L" & l + Compteuri).Value = Ws.Range("H" & j).Value
                  .Range("M" & l + Compteuri).Value = Ws.Range("R" & j).Value
                  .Range("AE" & l + Compteuri).Value = Ws.Range("Q" & j).Value
                  .Range("AF" & l + Compteuri).Value = Ws.Range("M" & j).Value
                  Compteuri = Compteuri + 1
                End With
              End If
            End With
          Next j
        End With
     
        For Each Sh In Worksheets
          For Each pvt In Sh.PivotTables
            pvt.RefreshTable
          Next pvt
        Next Sh
      End If
     
      Set Wb = Nothing
      Set Ws = Nothing
      Set Ws1 = Nothing
      Set Ws2 = Nothing
      Set MaPlage = Nothing
      Set MaPlage1 = Nothing
    End Sub

    Là, on se rend compte que la plupart de tes commentaires sont totalement inutiles et polluants.
    Ça permet aussi de voir immédiatement que tu fais une curieuse (pour ne pas dire dangereuse) utilisation des With (par ex. ligne 178 et 184 ?)

  10. #10
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 173
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 173
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    J'ajouterai à la réponse de Patrice, qu'il semble que toutes les variables ne sont pas déclarée comme par exemple les variables des lignes 14 à 43 (ex : Compteur = 0) et à ce sujet deux remarques.
    1. Il est parfaitement inutile en début de procédure d'initialiser les variables numériques à 0.
    2. Ce nombre de variables même si je doute de son utilité, devrait être remplacé par une variable tableau soit Compteur(1), Compteur(2), etc.

    Pour la déclaration des variables, il est indispensable pour s'éviter des heures de recherche, de placer Option Explicit en tête de module et il est important de typer les variables

    Je conseille la lecture de
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

Discussions similaires

  1. De la rapidité du code
    Par jfloviou dans le forum Contribuez
    Réponses: 233
    Dernier message: 29/05/2009, 02h17
  2. code pour interbase 6.0 et 6.5 de generateur
    Par tripper.dim dans le forum InterBase
    Réponses: 4
    Dernier message: 01/07/2002, 11h29
  3. [MFC](encapsulation ADO) ou placer le code
    Par philippe V dans le forum MFC
    Réponses: 2
    Dernier message: 13/06/2002, 14h58
  4. Explorateur de code C
    Par Zero dans le forum C
    Réponses: 14
    Dernier message: 06/06/2002, 09h41
  5. OmniORB : code sous Windows et Linux
    Par debug dans le forum CORBA
    Réponses: 2
    Dernier message: 30/04/2002, 17h45

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo