Adaptation code macro copier coller dans une feuille synthèse

Le 14/01/2022 à 11:13

Bonjour,

Toute toute débutante je n'arrive pas à adapter le code ci dessous pour qu'il ne s'exécute que sur les 15 premières colonnes ( de A à O)

Ce code permet de copier le contenu des toutes les feuilles sur une feuille synthèse.

Un grand merci pour votre aide

Sub copieFeuilDansBDDCUMUL()

Range("A:S").ClearContents

' Boucle sur chaque Feuille (Sauf les deux premières qui sont les Syntheses)
For i = 3 To Sheets.Count

    Sheets(i).AutoFilterMode = False ' Suppression de tout Filtre
    Sheets(i).Rows("2:" & Sheets(i).Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy 'Copie

    LigneCollage = Sheets("BDD CUMUL").Range("A" & Rows.Count).End(xlUp).Row + 1 'Recherche de la ligne de collage
    If LigneCollage < 2 Then LigneCollage = 2

    Sheets("BDD CUMUL").Range("A" & LigneCollage).PasteSpecial 'Collage
    Application.CutCopyMode = False
    Sheets(i).AutoFilterMode = False ' Suppression de tout Filtre

Next i

Sheets("Feuil 01").Select
Range("A1:O1").Select 'pour la la ligne de titre se colle dans la BDD
    Selection.Copy
    Sheets("BDD CUMUL").Select
    Range("A1").Select
    ActiveSheet.Paste

Range("AH2") = "MAJ le:" & Format(Date, "dd.mm.yyyy")

End Sub
Le 14/01/2022 à 11:51

Bonjour pms, bienvenue sur XLP ,

Essayez ce code :

Sub copieFeuilDansBDDCUMUL()
Dim Dest As Worksheet, i As Long, LigneCollage As Long, DerLig As Long

   Set Dest = Sheets("BDD CUMUL")
   Dest.Range("A:S").ClearContents
   ' Boucle sur chaque Feuille (Sauf les deux premières qui sont les Syntheses)
   For i = 3 To Sheets.Count
      With Sheets(i)
         If .FilterMode Then .ShowAllData       'tout afficher
         DerLig = .Range("A" & Rows.Count).End(xlUp).Row
         If DerLig > 1 Then
            .Range("A2:O" & .Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy    'Copie colonne A à O cellules visibles
            LigneCollage = Dest.Range("A" & .Rows.Count).End(xlUp).Row + 1 'Recherche de la ligne de collage
            If LigneCollage < 2 Then LigneCollage = 2
            Dest.Range("A" & LigneCollage).PasteSpecial xlPasteValues      'collage
         End If
      End With
   Next i
   Sheets("Feuil 01").Range("A1:O1").Copy Dest.Range("a1")
   Sheets("Feuil 01").Range("AH2") = "MAJ le:" & Format(Date, "dd.mm.yyyy")
   Application.CutCopyMode = False
End Sub
Le 14/01/2022 à 12:15

Dingue !! Merci merci merci merci infiniment !!

Promis dernière dernière question comment faire pour que le code ne s'éxécute pas si sur une feuille les lignes ne sont pas remplies ?

( L'idée c'est que chaque mois on remplit une feuille mais en mars seule trois feuilles sont complétés et j'aimerai que le code ne tourne pas sur les feuilles de avril à décembre).

Le 14/01/2022 à 12:30

Re,

Avec la version actuelle du code présent dans mon premier message, on parcourt toute les feuilles au-delà à partir de la troisième.

Mais pour chaque feuille, on vérifie qu'il y a au moins une ligne de donnée, si ce n'est pas le cas, alors on passe la copie (utilisation de la variable DerLig)

Ca devrait répondre à votre besoin.

Le 14/01/2022 à 12:42

Vraiment génial génial génial !! Merci merci merci !!

J'espère un jour être aussi douée que vous !

Bon après midi et encore mille merci

Rechercher des sujets similaires à "adaptation code macro copier coller feuille synthese"