Extraire des plages de longueurs differentes vers d'autres feuilles

[bobylaroche]

Bonjour à tous,
Il y a longtemps que je n'ai pas sollicité votre aide, mais là je suis encore au bouillon.
Voila le problème. Sur une feuille, j'ai plusieur plages de dates de longueurs differentes (20 plages de dates au maximum).
Je souhaiterai extraire chacune de ces plages dans des feuilles differentes nommées N1 à N20 et chaque extraction devrait commencer en cellule B8 de chaque feuille.
Il est important de conserver les feuilles existantes (N1 à N20) car elles vont contenir des formules.
Je vous joins un exemple propre. Voir jusqu'à la feuille N4 pour comprendre.
Par avance, merci.
Cordialement,

 

[Paf]

Re : Extraire des plages de longueurs differentes vers d'autres feuilles

Bonjour,

a priori c'est une opération qui ne sera faite qu'une seule fois.

Il serait plus "rentable" de faire la copie manuellement.

A+

 

[bobylaroche]

Re : Extraire des plages de longueurs differentes vers d'autres feuilles

Bonjour Paf,

Ce n'est qu'un exemple, j'ai 24 à 60 feuilles de ce type à traiter quotidiennement.

@+

 

[Paf]

Re : Extraire des plages de longueurs differentes vers d'autres feuilles

Re,

A essayer.

Le code ci dessous ne fonctionne que sur la structure de l'exemple fourni. si chaque plage ne débute pas de la même manière, si le nombre de ligne entre la première ligne de plage et les données à copier est différent, si l'espacement entre fin de plage et début de la suivante est différent, les données copiées ne correspondront pas aux plages !
a adapter

Sub bobylaroche()
Dim DerLig As Long, TabLigDeb, TabLigFin, i As Integer, x As Integer
Dim WS1 As Worksheet

Set WS1 = Worksheets("Chevaux")
x = 0

'********** determination des lignes de début et fin de plages
DerLig = WS1.Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne non vide
'**** determination des lignes débit de plage
ReDim TabLigDeb(x)
For i = 1 To DerLig
    If WS1.Cells(i, 1) <> "" And WS1.Cells(i, 2) = "" Then
        TabLigDeb(x) = i + 6
        x = x + 1
        ReDim Preserve TabLigDeb(x)
     End If
Next
'**controle si le nb de plage ne dépasse pas le nb de feuille
If UBound(TabLigDeb) > Worksheets.Count - 1 Then
    MsgBox "Il y a plus de plages à traiter que feuilles !!!"
    Exit Sub
End If

'**** determination des lignes fin de plage
ReDim TabLigFin(UBound(TabLigDeb))

For i = 0 To UBound(TabLigDeb) - 1
    If i < UBound(TabLigDeb) - 1 Then
        TabLigFin(i) = TabLigDeb(i + 1) - 8
    Else
        TabLigFin(i) = DerLig
    End If
Next

'****copie de chaque plage dans les feuilles
For i = 0 To UBound(TabLigDeb) - 1
    WS1.Range("A" & TabLigDeb(i) & ":M" & TabLigFin(i)).Copy Worksheets(i + 2).Range("B8")
Next

End Sub

A+

 

[bobylaroche]

Re : Extraire des plages de longueurs differentes vers d'autres feuilles

Merci Paf, J'y suis presque 😀
Ton code fonctionne pour le même nombre de "blocs" dates à extraire que celui fourni en l'exemple, c'est à dire 18
(n1 à n18). En fait, ce nombre de "blocs" peut varier de 8 à 20 soit (n1 à n8, n1 à n9, n1 à n10,,etc..jusqu'à n20).
Je vais essayer de mofifier ton code. En tout cas, un grand merci 😀

 

[Paf]

Re : Extraire des plages de longueurs differentes vers d'autres feuilles

re,

Ton code fonctionne pour le même nombre de "blocs" dates à extraire que celui fourni en l'exemple, c'est à dire 18

Non !,le code est fait pour copier chaque plage de la feuille N1 à la feuille Nxx...

s'il n'y a qu'une plage il la copie en N1, s'il y a 2 plages : une en N1 l'autre en N2 , ...

La seule limitation est le nombre de plages, s'il y a plus de 20 plages, message " Il y a plus de plages que de feuilles" et sortie de la macro.

A+

 

[bobylaroche]

Re : Extraire des plages de longueurs differentes vers d'autres feuilles

Bonjour Pat,

C'est parfait, cela fonctionne à merveille 🙂
Merci bien pour ton aide.