copié vers un nouveau classeur

[iliess]

Bonjour
Ma feuille rapprochement contienne des tableaux l’un âpres l’autre.
Premier tableau A1 :A31 ---------> 31 lignes
Deuxième tableau A32 :A62 ---------> 31 lignes
Troisième tableau A63 :A93 ---------> 31 lignes
Dernier tableau A435 :A465 ---------> 31 lignes
Questions
SVP comment copier les tableaux dans un nouveau classeur et mettre chaque tableau dans une feuille et nommer chaque feuille par la valeur des cellules en jaune G5 G36 G67 ……………….
Conclusion
Nouveau classeur
Feuil1 contient tableau1 (A1 :A31) nommer (valeur cellule G5)
Feuil2 contient tableau1 (A32 :A62) nommer (valeur cellule G36)
…………………………
Merci beaucoup

 

[job75]

Re : copié vers un nouveau classeur

Bonjour iliess,

Voyez le fichier joint avec cette macro :

Sub CopierTableaux()
Dim F As Worksheet, h As Integer, n As Integer, i As Integer
Set F = ActiveSheet
h = 31 'hauteur de chaque tableau
n = Application.CountIf([A:A], [A1]) 'nombre de tableaux
Application.ScreenUpdating = False
Application.SheetsInNewWorkbook = n
Workbooks.Add 'nouveau document
Application.SheetsInNewWorkbook = 3
For i = 1 To n
  With ActiveWorkbook.Sheets(i)
    F.Cells.Copy .Cells
    If i > 1 Then .Rows("1:" & h * (i - 1)).Delete
    .Rows(h + 1 & ":65536").Delete
    .Name = .[G5].Text 'renomme la feuille
  End With
Next
End Sub

Ici le nouveau document créé n'est pas enregistré.

On peut l'enregistrer automatiquement avec cette ligne de code :

ActiveWorkbook.SaveAs chemin & "\" & nomfichier 'définir chemin et nomfichier

A+

 

[job75]

Re : copié vers un nouveau classeur

Bonjour iliess, le forum,

2 remarques importantes sur la macro précédente.

Il y aura un bug (dépassement de capacité) si h * (i - 1) dépasse 32767 (1058 tableaux).

Dans ce cas déclarer n et i As Long.

Et sur Excel 2007, s'il y a plus de 2114 tableaux, écrire :

.Rows(h + 1 & ":" & .Rows.Count).Delete

Le fichier (2) joint fonctionne dans tous les cas de figure.

A+