VBA - Boucle avec recopie incrémentée à partir d'une formule

Bonjour à tous,

Je suis une toute nouvelle pratiquante VBA ! Excusez donc mon trop peu de connaissances sur ce sujet...

Afin de me faciliter la vie, j'ai décidé de m'y mettre : Here is my problem !

Imaginez donc une grosse base de données avec date de début/Date de fin.

De cette base, il me faut tirer les informations par semaines : je me suis donc créer un tableau avec numéro de semaines et dates correspondantes.

Je veux donc rentrer le n° de semaine de fin, pour que la VBA puisse aller dans le TCD, rafraîchir les données /semaines jusqu’à n° de fin et les coller dans une autre feuille à la suite les unes des autres.

Ma base se colle parfaitement à la suite (la boucle n'étant pas encore faite mais j'attends de résoudre mon pb avant de m'y mettre...) mais les formules m'indiquant l'année, le mois et la semaine c'est autre chose.

Les données rafraîchies du TCD se colle dans les colonnes D à E. Et les colonnes A B et C doivent mettre les semaines correspondantes avec mois et année.

Pb : Je n'arrive pas à copier la dernière ligne des colonnes ABC créée par mon code pour pouvoir l'incrémenter jusqu'à la dernière ligne de ma colonne D.

Voici mon code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

Sub MacroBoucle() Dim nb As Integer nb = InputBox("Saisissez le numéro de semaine final") Dim rng As Range DerLigne = Sheets("Base CP Semaine").Range("A" & 65000).End(xlUp).Row   'Entrer le numéro de semaine final   Sheets("PARAMETRES").Select Range("E1").Select Selection.Value = nb   'Copier les données de la semaine   Range("E2").Select Sheets("Dyna CP").Select Range("A5:B34").Select ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotCache.Refresh Selection.Copy   'Coller les données de la semaine Sheets("Base CP Semaine").Select Range("D65000").End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False   'Formule pour n° de semaine / mois / année   Range("A65000").End(xlUp).Offset(1).Select ActiveCell.FormulaR1C1 = "=YEAR(PARAMETRES!R2C2)" Range("B65000").End(xlUp).Offset(1).Select ActiveCell.FormulaR1C1 = "=MONTH(PARAMETRES!R2C2)" Range("C65000").End(xlUp).Offset(1).Select ActiveCell.FormulaR1C1 = "=PARAMETRES!R1C5" Range("A1:C65000").Value = Range("A1:C65000").Value   End Sub

---

Si vous n'avez pas bien saisie, je reste à dispo !

Merci d'avance pour vos réponses !

Une débutante VBA

Bonjour,
Je sais que ce n'est pas ta question mais en VBA, il faut proscrire les méthodes SELECT et l'emploie de l'objet Selection ainsi, cette ligne de code

Code:

---

1 2 3

Sheets("PARAMETRES").Select Range("E1").Select Selection.Value = nb

---

Se résumera tout simplement par cette ligne

Code:

---

Sheets("PARAMETRES").Range("E1").Value = nb

---

et de préférence en la faisant précéder par l'objet parent de la feuille ThisWorkbook

Si tu dois régulièrement mettre à jour les données sources du TCD, je te conseille de transformer la liste de données source par un tableau.
Commande Tableau du groupe Tableaux de l'onglet [Insertion].
A partir de ce moment là, les lignes et colonnes qui seraient ajoutées à la source seront dynamiquement accessible dans le TCD par le simple fait de cliquer sur la commande Actualiser.

Bonjour Philippe,


Merci pour vos conseils ça ne pourra que raccourcir mon code ! En attendant j'ai trouvé une solution pour copier la dernière ligne du code que je viens de créer grâce aux formules : seul pb je n'arrive pas à créer le code pour me copier les trois colonnes...

Voici le code pour copier ma dernière ligne (De A à C):

Code:

---

1 2 3 4 5 6 7

Sub MacroBoucle()   derLigne = Sheets("Base CP Semaine").Range([A65000], [C65000]).End(xlUp).Row + 1   Sheets("Base CP Semaine").Range("A" & derLigne).Copy   End Sub

---

Je sais.... La réponse doit être évidente ! Pourtant j'ai essayé pas mal de chose et rien ne fonctionne...

Simplement sélectionner la dernière ligne que le code vient de créer de A à C.... Et avec ce code il ne me sélectionne que la dernière ligne de la colonne A.

Merci d'avance pour vos réponses ! Et encore merci Philippe :)

Marine

Bonjour,
Pour ma part, j'utilise la propriété CurrentRegion d'une plage de cellule pour en connaître la zone Ligne/Colonne
Les deux listes de cet exemple commencent en cellule A1
Voici un exemple de la copie de la dernière ligne d'une plage source vers la prochaine ligne vide de la plage cible

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub CopyRow() Dim rngSource As Range, rngTarget As Range, LastRowSrce As Long With ThisWorkbook Set rngSource = .Worksheets("db").Range("A1").CurrentRegion Set rngTarget = .Worksheets("Export").Range("A1").CurrentRegion End With LastRowSrce = rngSource.Rows.Count ' Dernière ligne de la source With rngTarget rngSource.Rows(LastRowSrce).Copy .Cells(.Rows.Count + 1, 1) End With Set rngSource = Nothing: Set rngTarget = Nothing End Sub

---

Je crois que je me suis mal exprimée Philippe.

Plus simple :

Quel serait le code pour déterminer la dernière ligne de mes colonnes A B et C sachant que D et E sont déjà remplies ;

A B C D E
x x x x x
x x x x x
........x x
........x x

Je voudrais copier la ligne soulignée (après l'avoir déterminée dans mon code) et la coller jusqu'à la dernière ligne de D (en italique)

Merci encore du temps que vous consacrez à mes questions !

Du coup ça serait de changer ce code :

Code:

---

derLigne = Sheets("Base CP Semaine").Range([A65000], [C65000]).End(xlUp).Row + 1

---

je ne sais pas si [A65000],[C65000] marche réellement, ça m’entonnerait !

Code:

---

1 2 3

Sheets("Base CP Semaine").Range("A" & derLigne).Copy Range("A65000").End(xlUp).Offset(1).Select Range("A2:A" & Range("D" & Rows.Count).End(xlUp).Row).PasteSpecial

---

en sorte de

Code:

---

1 2 3

Sheets("Base CP Semaine").Range("A:C" & derLigne).Copy Range("A65000:C65000").End(xlUp).Offset(1).Select Range("???" & Range("D" & Rows.Count).End(xlUp).Row).PasteSpecial

---

Bonjour,
Je n'avais effectivement pas compris.
Voilà le code adapté. La modification a été effectuée aux lignes 7 et 9 du code

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub CopyRow() Dim rngSource As Range, rngTarget As Range, LastRowSrce As Long With ThisWorkbook Set rngSource = .Worksheets("db").Range("A1").CurrentRegion Set rngTarget = .Worksheets("Export").Range("A1").CurrentRegion End With LastRowSrce = rngSource.Range("A1").End(xlDown).Row ' Dernière ligne de la colonne A de la source With rngTarget rngSource.Rows(LastRowSrce).Resize(, 3).Copy .Cells(.Rows.Count + 1, 1) ' Copie des trois colonnes de la dernière ligne de la colonne A End With Set rngSource = Nothing: Set rngTarget = Nothing End Sub

---

Super !!! On y est presque... Mais il y a toujours un mais...

Pièce jointe 172458

Pourquoi le code ne copie que les cellules de A2 à C2 ?

.... Et je ne vois pas où le code fait ça.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub CopyRow()   Dim rngSource As Range, rngTarget As Range, LastRowSrce As Long   With ThisWorkbook Set rngSource = .Worksheets("Base CP Semaine").Range("A1").CurrentRegion Set rngTarget = .Worksheets("Base CP Semaine").Range("A1").CurrentRegion End With LastRowSrce = rngSource.Range("A1").End(xlDown).Row ' Dernière ligne de la colonne A de la source With rngTarget rngSource.Rows(LastRowSrce).Resize(, 3).Copy .Cells(.Rows.Count, 1) ' Copie des trois colonnes de la dernière ligne de la colonne A End With Set rngSource = Nothing: Set rngTarget = Nothing   End Sub

---

J'ai trouvé Philippe !!! Il suffisait de remplacer ("A1").End(xlDown) par ("A65000").End(xlUp) !!!

Merci encore pour votre aide ! :)

Bonjour,
Ce qui est dommage, c'est que lorsque l'on pose des questions les renseignements donnés sont souvent inexacts ou incomplets.
Ma dernière réponse accompagnée d'un code était basé sur l'illustration de ce fil qui n'a rien à voir avec la dernière image.

Oui vous avez raison, sans exemple concret difficile de bien faire comprendre ce que l'on veut. Mais même sans ça, vous avez réussi à m'aiguiller sur la bonne voie !

J'abuse si je demande une dernière chose ? Allez, je me lance. Si vous regardez bien sur mon image, les cellules du milieu ne se remplissent pas... Y a t-il possibilité dans votre code de palier à ce problème ?

Il ne colle qu'à la fin de la nouvelle insertion.

Merci Philippe

Bonjour,

Citation:

---

Si vous regardez bien sur mon image, les cellules du milieu ne se remplissent pas... Y a t-il possibilité dans votre code de palier à ce problème ?

---

L'image montre une plage de cellules de cinq colonnes dont les trois premières ont certaines cellules vides. Alors j'avoue ne pas comprendre de quoi on parle pour les cellules du milieu.
De plus cette image ne représente-t-elle pas un tableau croisé dynamique ?
Si c'est le cas, il faut passer par l'actualisation.

Bonjour,

Ce n'est pas un TdB mais bien la base que je viens alimenter grace à ma macro qui prend les informations dans des TdB en fonction de valeurs.

C'est donc une base créée par la macro.

Dans le code, c'est au niveau du collage que je n'arrive pas à déterminer où je pourrais inclure une variable qui dirait à mon code de coller toutes les lignes jusqu'à la dernière ligne de la colonne D. Là il ne colle qu'une ligne à la fin.

Pièce jointe 172511

Dans l'exemple ci dessus il faudrait en fait remplir les lignes jaunes... Finalement faire une recopie incrémentée de A20:C20 à A28:C28

Je pense que ça doit se faire dans cette partie du code :

Code:

---

rngSource.Rows(LastRowSrce).Resize(, 3).Copy .Cells(.Rows.Count, 1) ' Copie des trois colonnes de la dernière ligne de la colonne A

---

Merci Philippe,

Marine

Les lignes A11:C11 à A19:C19 étant ce que je voudrais que cela donne !

Bonjour,
Les lignes A3:C9 ne doivent pas être remplies ?
Sinon c'est très simple.
Manuellement

1. Sélectionner la plage de cellules (Sélectionner A1 puis Ctrl + *)
2. Afficher la boîte de dialogue Atteindre (Touche F5)
3. Cliquer sur le bouton Cellules... et dans la boîte de dialogue, sélectionner Cellules vides puis confirmer par OK
4. Dans la cellule active, taper une formule qui fait référence à la cellule immédiatement au-dessus et confirmer par Ctrl+Entrée
5. Ensuite sélectionner à nouveau la plage de cellules et faire un Copier/Collage Spécial-Valeur

C'est terminé

Avec une procédure VBA, c'est encore plus simple

Code:

---

1 2 3 4 5 6

Sub FillEmptyCells() With ThisWorkbook.Worksheets("db").Range("A1").CurrentRegion .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" .Value = .Value ' Equivalent Copier/Collage Special Valeur End With End Sub

---