Copier plusieurs onglets dans un seul

Signaler
Messages postés
3
Date d'inscription
mercredi 30 mars 2011
Statut
Membre
Dernière intervention
6 avril 2011
-
Messages postés
113
Date d'inscription
lundi 31 mars 2003
Statut
Membre
Dernière intervention
19 décembre 2011
-
Bonjour à toutes et tous,

j'ai une macro qui me permet de copier plusieurs onglets (nommés) dans un onglet de synthèse reprenant tous
les tableaux.

Mon souci est lorsque l'onglet est vide, la macro bloque.

exemple :

Sheets("Air Mauritius").Select
Range("A9:R9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Global").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select

Sheets("Air Austral").Select
Range("A9:R9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Global").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select

je voudrais que lorsque l'onglet n'a pas d'information il passe à la commande suivante ....Help please.

YSA97420

3 réponses

Messages postés
113
Date d'inscription
lundi 31 mars 2003
Statut
Membre
Dernière intervention
19 décembre 2011
2
Salut,

Et au dessus de A9:R9, il y a quelquechose ?

Pac
Messages postés
3
Date d'inscription
mercredi 30 mars 2011
Statut
Membre
Dernière intervention
6 avril 2011

Salut,

il y a la ligne des entêtes de colonnes.

"nom" "prenom" "adresse" ect ...

YSA97420
Messages postés
113
Date d'inscription
lundi 31 mars 2003
Statut
Membre
Dernière intervention
19 décembre 2011
2
Salut,

Dim sh As Worksheet
Dim destsh As Worksheet

    Set destsh = Worksheets("Global")

    For Each sh In ThisWorkbook.Worksheets
    
        If sh.Name <> destsh.Name Then
            
            If sh.UsedRange.Count > 1 Then
                
                sh.Activate
                sh.Range("A9").Select
                
                If Not IsEmpty(Selection) Then
                
                    sh.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
                
                    With Selection
                    
                        destsh.Activate
                        destsh.Cells(LastRow(destsh) + 1, 1).Resize(.Rows.Count, .Columns.Count).Value = .Value
                
                    End With
                    
                End If
            
            End If
        
        End If
    
    Next
    
    Set destsh = Nothing


Avec la fonction :
Function LastRow(sh As Worksheet)
    
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    On Error GoTo 0
    
End Function


A perfectionner...

Pac