Copier plusieurs onglets dans un seul

Question

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

cs_pacadebord · Answer

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

YSA974 · Answer

Salut,

il y a la ligne des entêtes de colonnes.

"nom" "prenom" "adresse" ect ...

YSA97420

cs_pacadebord · Answer

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

Copier plusieurs onglets dans un seul

3 réponses

Votre réponse

Discussions similaires