Copier Coller toutes les 25 lignes en VBA

[alpilon]

Bonjour,

Voici mon souci, avec une extract en boucle, je récupère plusieurs séries de lignes web qui varient de 5 à 20, les unes sous les autres comme ceci :

bidule1
1
2
3
4
5
6
bidule2
1
2
3
4
bidule3
1
2
3
4
5
6
7
8
9
etc..

j'aimerais récupérer ces séries toutes les 25 lignes

j'ai bien essayé avec cette fonction en bougeant le 1 de offset, ce qui agit bien au bon endroit, mais bien sûr c'est fixe, et je ne sais pas comment coder mon problème

Function DernCell() As Range
    With ActiveSheet
        Set DernCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
End Function

sachant qu'il ne faut pas insérer de lignes, mais coller toutes les 25 lignes.

si vous pouvez m'aider, merci à vous

Alpilon

 

[Paritec]

Re : Copier Coller toutes les 25 lignes en VBA

Bonjour Alpillon le forum,
un petit fichier avec ta liste à traiter et le résultat souhaité dans une autre feuille et on va te faire cela
a+
Papou😱

 

[alpilon]

Re : Copier Coller toutes les 25 lignes en VBA

Voili voila

 

[julberto]

Re : Copier Coller toutes les 25 lignes en VBA

Bonjour alpilon

Ceci te convient-il ?

Option Explicit

Sub InsertionLignes()
Dim nbCol As Integer, i As Integer, n As Integer
Dim nbLigne As Long, rpre() As Long
Dim plage As Range, cel As Range, zone As String

Set plage = Worksheets("Données").Range("A1").CurrentRegion
nbCol = plage.End(xlToRight).Column
nbLigne = plage.End(xlDown).Row
For Each cel In plage.Columns(2).Cells
   If IsEmpty(cel) Then
      n = n + 1
      ReDim Preserve repaire(n)
      rpre(n) = cel.Row
   End If
Next
For i = n - 1 To 1 Step -1
   zone = CStr(rpre(i + 1)) & ":" & CStr(23 + rpre(i))
   plage.Rows(zone).Insert Shift:=xlDown
Next i

End Sub

cordialement

 

[alpilon]

Re : Copier Coller toutes les 25 lignes en VBA

Bonjour Julberto,
Ta macro est parfaite pour insérer des lignes, mais je spécifiais plutôt une recopie des données, car je voulais éviter un décalage des lignes adjacentes des tableaux fixes.
Vois le fichier ci-joint, clic sur GO et tu comprendra, après la macro la celulle G9 fait référence à la cellule A26 alors que je souhaiterais qu'elle fasse toujours référence à la celule A9

ps : une petite erreur corrigée sur le mot repaire dans ta macro que je remets ici pour ceux qui veulent l'utiliser.

Option Explicit

Sub InsertionLignes()
Dim nbCol As Integer, i As Integer, n As Integer
Dim nbLigne As Long, rpre() As Long
Dim plage As Range, cel As Range, zone As String

Set plage = Worksheets("Données").Range("A1").CurrentRegion
nbCol = plage.End(xlToRight).Column
nbLigne = plage.End(xlDown).Row
For Each cel In plage.Columns(2).Cells
   If IsEmpty(cel) Then
      n = n + 1
      ReDim Preserve rpre(n)
      rpre(n) = cel.Row
   End If
Next
For i = n - 1 To 1 Step -1
   zone = CStr(rpre(i + 1)) & ":" & CStr(23 + rpre(i))
   plage.Rows(zone).Insert Shift:=xlDown
Next i

End Sub

Cordialement
Alpilon

 

[julberto]

Re : Copier Coller toutes les 25 lignes en VBA

Bonjour alpilon,

J'ai du mal à cerner ce à quoi tu veux arriver.
1 - Essaye cette macro dans son intégralité.
2 - Si cela ne te convient pas, supprime les dernières lignes de code sauf celle marquée " '******** ". Puis reteste la nouvelle mouture.

Option Explicit

Sub InsertionLignes()
Dim nbCol As Integer, i As Integer, n As Integer
Dim nbLigne As Long, rpre() As Long
Dim plage As Range, cel As Range, zone As String

Application.ScreenUpdating = False
Sheets.Add after:=Worksheets("Données")
ActiveSheet.Name = "Clone"
Set plage = Worksheets("Données").Range("A1").CurrentRegion
plage.Copy Destination:=Worksheets("Clone").Range("A1")
Set plage = Worksheets("Clone").Range("A1").CurrentRegion
nbCol = plage.End(xlToRight).Column
nbLigne = plage.End(xlDown).Row

For Each cel In plage.Columns(2).Cells
   If IsEmpty(cel) Then
      n = n + 1
      ReDim Preserve rpre(n)
      rpre(n) = cel.Row
   End If
Next
For i = n - 1 To 1 Step -1
   zone = CStr(rpre(i + 1)) & ":" & CStr(23 + rpre(i))
   plage.Rows(zone).Insert Shift:=xlDown
Next i

' réintégration sur la feuille "Données"
nbLigne = n * 24
plage.Resize(nbLigne).Copy Destination:=Worksheets("Données").Range("A1")
'suppression de la feuille intermédiaire
Application.DisplayAlerts = False
Worksheets("Clone").Delete
Worksheets("Données").Activate
Application.ScreenUpdating = True         '*************

End Sub

cordialement

 

[alpilon]

Re : Copier Coller toutes les 25 lignes en VBA

Julberto, tu as parfaitement cerné ce que je souhaitais, Merci mille fois, c'est parfait.

Alpilon