XL 2013 VBA - COPIER DERNIERE LIGNE D'UN TABLEAU SUR PLUSIEURS LIGNES

[CARO13]

Bonjour

j'ai besoin d'aide sur une macro où je souhaite rechercher la dernière ligne de la colonne A, et recopier la ligne entière jusqu'à ligne 3000

J'ai trouvé la macro suivante qui fonctionne mais elle ne recopie que sur une ligne
Qu'est ce que je dois ajouter pour qu'elle recopie à chaque fois jusque la ligne 3000

Merci d'avance pour votre aide précieuse


Sheets("BASE").Select
Dim derligne As Long
derligne = Range("A" & Rows.Count).End(xlUp).Row
Rows(derligne).Copy Destination:=Rows(derligne + 1)

End Sub

 

[fanfan38]

Bonjour

Sheets("BASE").Select
Dim derligne As Long, i as long
derligne = Range("A" & Rows.Count).End(xlUp).Row
for i=derligne to derligne+3000
  Rows(i).Copy Destination:=Rows(i + 1)
next

A+ François

 

[pierrejean]

Bonjour CARO13
A tester
Sheets("BASE").Select
Dim derligne As Long
derligne = Range("A" & Rows.Count).End(xlUp).Row
cible=derligne + 1
while cible<3000
Rows(derligne).Copy Destination:=Rows(cible)
cible=cible+1
wend

 

[CARO13]

Les 2 fonctionnent parfaitement ! un grand merci pour votre aide,

Par contre, je trouve que le traitement est un peu long
mais je ne vois pas comment le réduire

Encore merci !

 

[pierrejean]

Re

ceci devrait être plus rapide

Sub test()
Sheets("BASE").Select
Dim derligne As Long
derligne = Range("A" & Rows.Count).End(xlUp).Row
dercol = Cells(derligne, Columns.Count).End(xlToLeft).Column
tablo = Range(Cells(derligne, 1).Address & ":" & Cells(derligne, dercol).Address)
ReDim tabres(3000 - derligne, 1 To dercol)
For n = LBound(tabres, 1) To UBound(tabres, 1)
   For m = LBound(tabres, 2) To UBound(tabres, 2)
      tabres(n, m) = tablo(1, m)
   Next
Next
Range("A" & derligne + 1).Resize(UBound(tabres, 1), UBound(tabres, 2)) = tabres
End Sub

 

[CARO13]

En effet beaucoup plus rapide, mais ca ne recopie pas le format ni les formules. Ca ne recopie que les valeurs

 

[job75]

Bonjour CARO13, fanfan38, Pierre,

Pourquoi faire une boucle ? Ceci est immédiat et copie formules et formats :

Sub Copier()
With Range("A" & Rows.Count).End(xlUp).EntireRow
    If .Row < 3000 Then .Copy .Rows(2).Resize(3000 - .Row)
End With
End Sub

A+

 

[CARO13]

Bonjour Job75
en effet c'est exactement ce qu'il fallait et ca fonctionne merveilleusement.
parfois on cherche compliqué ...et j'ai chercher une paire d'heure avant de poster ma demande !

Un grand merci à vous 3 d'avoir pris le temps de m'aider je vais pouvoir finir mon fichier !

Bonne fin de journée !