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:

---

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

voici ce que j'ai pu améliorer mis tojours aussi long pour la mise à "null"

Code:

---

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

---

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.

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:

---

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

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

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...

Bonjour Philippe,

Pour y répondre à :

Citation:

---

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

Bonjour Patrice,

sans vouloir être autun

Citation:

---

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

Bonjour,

Citation:

---

Envoyé par ALEX80800

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:

---

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 ?)

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

• Utiliser les variables en VBA Excel
• Utiliser les variables tableaux en VBA Excel
• Vos premiers pas dans l'éditeur de macros Exc et particulièrement le chapitre V. Conseils et astuces