Création d'un onglet en cas de dépassement de 65536 lignes

[perdinch]

Bonjour, la macro suivante récupére le contenu d'une quarantaine d'onglets d'un même classeur.
mais il arrive (en fin d'année) que l'on dépasse les 65536 lignes.

pouvez m'aider à adapter cette macro lorsque le fichier est suceptible de dépasser les 65536 lignes...on pourrait créer un onglet supplementaire pour les lignes au delà de 65536 par exemple

For Each feuill In Sheets 'boucle sur tous les onglets du classeur
Select Case Left(Feuill.Name, 6) 'action en fonction des 6 premières lettres du nom de l'onglet
Case "recupe" 'cas "recupe"
Set dest = Sheets("ALL").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellue de destination
Feuill.UsedRange.Copy dest 'copie et colle la plage
End Select 'fin de l'action en fonction de...
Next feuill 'prochain onglet de la boucle

merci de vos suggestions

perdinch

 

[pierrejean]

Re : Création d'un onglet en cas de dépassement de 65536 lignes

Bonjour perdinch

A tester:

Sub test()
For Each feuill In Sheets 'boucle sur tous les onglets du classeur
Select Case Left(feuill.Name, 6) 'action en fonction des 6 premières lettres du nom de l'onglet
Case "recupe" 'cas "recupe"
nbl_rest = 65536 - Sheets("ALL").Range("A65536").End(xlUp).Row
Set dest = Sheets("ALL").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellue de destination
If feuill.UsedRange.Rows < nbl_rest Then
  feuill.UsedRange.Copy dest
Else
  On Error Resume Next
    Sheets.Add.Name = "ALL2"
 On Error Goto 0
  Set dest = Sheets("ALL2").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellue de destination
  feuill.UsedRange.Copy dest
End If
  'copie et colle la plage
End Select 'fin de l'action en fonction de...
Next feuill 'prochain onglet de la boucle
End Sub

 

[perdinch]

Re : Création d'un onglet en cas de dépassement de 65536 lignes

Merci beaucoup.Aprés quelques minutes j'ai réussi à adapter votre code à ma macro.

Perdinch