Problème macro pour copie de plusieurs onglets

[MikaTI]

Bonjour à tous,

J'utilise une macro qui me permet de copier plusieurs onglets dans un onglet appelé "Feuil1"... dans le but de combiner toutes les données.

Cette macro fonctionne très bien.
Cependant, une petite interrogation sur une fonction que je n'arrive pas à intégrer dans cette macro.
Actuellement, ce qui est copié de chaque onglet, ce sont toutes les lignes dans lesquelles la première cellule n'est pas vide... Pour ça ok.
Mais, toutes les colonnes sont copiées.. Or j'essaie d'intégrer un code pour copier seulement le contenu des colonnes A à Z...

Voici ci dessous pour aide, le code utilisé pour copier tous les onglets...

Sub Compilation()
Dim LastLig As Long, NewLig As Long
Dim Ws As Worksheet
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    If LastLig > 1 Then .Rows(2 & ":" & LastLig).Clear
    NewLig = 2
    For Each Ws In ThisWorkbook.Worksheets
        If InStr("Feuil1| PISTES A DVP|", Ws.Name & "|") = 0 Then 
            LastLig = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
            Ws.Rows("1:" & LastLig).Copy .Range("A" & NewLig)
            NewLig = NewLig + LastLig + 1

With Sheets("Feuil1")
    With .Cells
        .FormatConditions.Delete
    End With
End With
        
        End If
    Next Ws
End With
End Sub

Si quelqu'un aurait une petite idée pour intégrer cela...

Merci bien

 

[Paf]

Re : Problème macro pour copie de plusieurs onglets

bonjour,

a priori remplacer

Ws.Rows("1:" & LastLig).Copy .Range("A" & NewLig)

par

Ws.Range("A1:Z" & LastLig).Copy .Range("A" & NewLig)

testé sur le classeur fourni.

A+

 

[MikaTI]

Re : Problème macro pour copie de plusieurs onglets

bonjour,

a priori remplacer


testé sur le classeur fourni.

A+

Bingo!!! J'avais fait a peu près pareil, sauf que j'avais mis "A:Z" et non "A1:Z"

Grand merciiiiii

 

[MikaTI]

Re : Problème macro pour copie de plusieurs onglets

bonjour,

a priori remplacer

Ws.Rows("1:" & LastLig).Copy .Range("A" & NewLig)

par

Ws.Range("A1:Z" & LastLig).Copy .Range("A" & NewLig)

testé sur le classeur fourni.

A+

Je reviens suite à la modification sur ma macro...
En fait quand je lançais ma macro initiale, ça prenait en compte les hauteurs des lignes, car certaines lignes ont des hauteurs différentes... Mais depuis que je fais le remplacement .Rows par .Range et bien ça ne prend plus en compte les hauteurs des onglets sources... Du coup toutes les lignes de l'onglet final ont la même hauteur... celle par défaut.

 

[Paf]

Re : Problème macro pour copie de plusieurs onglets

re,

peyt-être en conservant la copie de lignes pour garder le format, et en effaçant les colonnes de AA à ?? .

en fin de code ( avant le dernier End With):

 .Columns("AA:??").ClearContents

A+

 

[MikaTI]

Re : Problème macro pour copie de plusieurs onglets

re,

peyt-être en conservant la copie de lignes pour garder le format, et en effaçant les colonnes de AA à ?? .

A+

Hum non, ça n'a pas l'air de fonctionner, les hauteurs de mes lignes sont toutes identiques, et hauteur par défaut...

J'ai mis le code comme ceci

Sub Compilation()
Dim LastLig As Long, NewLig As Long
Dim Ws As Worksheet
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    If LastLig > 1 Then .Rows(2 & ":" & LastLig).Clear
    NewLig = 2
    For Each Ws In ThisWorkbook.Worksheets
        If InStr("Feuil1| PISTES A DVP|", Ws.Name & "|") = 0 Then    ' entre "" mettre le nom de toutes les feuilles à exclure séparés d'un | et à l'agout d'un nouvel onglet ajouter le nom
            LastLig = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
            Ws.Range("A1:AA" & LastLig).Copy .Range("A" & NewLig)
            NewLig = NewLig + LastLig + 1

With Sheets("Feuil1")
    With .Cells
        .FormatConditions.Delete
        .Columns("AA:ZZ").ClearContents
    End With
End With

        End If
    Next Ws
End With
End Sub

 

[Paf]

Re : Problème macro pour copie de plusieurs onglets

re,

si en utilisant Ws.Range("A1:Z" & LastLig).Copy .Range("A" & NewLig) les lignes ont toutes la mêmes taille, le fait de supprimer les cellules après la colonne Z ne va pas leur rendre la taille de la page de provenance.

C'est pourquoi je disais en conservant la copie de ligne; j'aurai du préciser en conservant l'instruction:
Ws.Rows("1:" & LastLig).Copy .Range("A" & NewLig)
qui, elle, copie en conservant le format des lignes

l'effacement des colonnes AA:ZZ peur se faire pour chaque feuille copiée (choix que vous avez fait) soit une seule fois après l'ensemble des copies en mettant l'instruction .Columns("AA:ZZ").ClearContents juste avant le dernier End With comme je le préconisais.

Par ailleurs les instructions With Sheets("Feuil1") et End With qui encadrent
With .Cells
...
End With

ne servent à rien puisqu'on se trouve déjà dans un With Sheets("Feuil1") et End With

A+

 

[MikaTI]

Re : Problème macro pour copie de plusieurs onglets

re,

si en utilisant Ws.Range("A1:Z" & LastLig).Copy .Range("A" & NewLig) les lignes ont toutes la mêmes taille, le fait de supprimer les cellules après la colonne Z ne va pas leur rendre la taille de la page de provenance.

C'est pourquoi je disais en conservant la copie de ligne; j'aurai du préciser en conservant l'instruction:
Ws.Rows("1:" & LastLig).Copy .Range("A" & NewLig)
qui, elle, copie en conservant le format des lignes

l'effacement des colonnes AA:ZZ peur se faire pour chaque feuille copiée (choix que vous avez fait) soit une seule fois après l'ensemble des copies en mettant l'instruction .Columns("AA:ZZ").ClearContents juste avant le dernier End With comme je le préconisais.

Par ailleurs les instructions With Sheets("Feuil1") et End With qui encadrent
With .Cells
...
End With

ne servent à rien puisqu'on se trouve déjà dans un With Sheets("Feuil1") et End With

A+

Ah mais j'avais du lire trop rapidement votre réponse, désolé!!! ^^

C'est ok c'est fonctionnel! Et merci pour l'info du surplus de code

Voici le code intégral (pour ceux que ça voudrait intéresser)
Seulement j'ai juste mis "CLEAR" sinon ça me conservait les bordures et la couleur de remplissage

Merci beaucoup Paf!!!!!

Sub Compilation()
Dim LastLig As Long, NewLig As Long
Dim Ws As Worksheet
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    If LastLig > 1 Then .Rows(2 & ":" & LastLig).Clear
    NewLig = 2
    For Each Ws In ThisWorkbook.Worksheets
        If InStr("Feuil1| PISTES A DVP|", Ws.Name & "|") = 0 Then    ' entre "" mettre le nom de toutes les feuilles à exclure séparés d'un | et à l'agout d'un nouvel onglet ajouter le nom
            LastLig = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
            Ws.Rows("1:" & LastLig).Copy .Range("A" & NewLig)
            NewLig = NewLig + LastLig + 1

    With .Cells
        .FormatConditions.Delete
        .Columns("AA:AZ").Clear
    End With
        
        End If
    Next Ws
End With
End Sub