Faire une boucle mais sans valeur en dure

Yannnnick

XLDnaute Nouveau
Bonjour à tous,

Voila j'ai mis en place un code (grâce à vous!!!) et j'aurais besoin de l'améliorer.

Voici mon code actuel :

Sub TransfertDonnees()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim rg As Range
Dim L1 As Integer, L2 As Integer
Dim rgC As Range, rgP As Range

Application.ScreenUpdating = False



Set ws1 = ThisWorkbook.Sheets("Var_FTE_LE2011.09") 'feuille de départ
Set ws3 = ThisWorkbook.Sheets("Var_EEP_LE2011.09") 'feuille de départ



Set ws2 = ThisWorkbook.Sheets("Data_Headcount_Magnitude") 'feuille de destination

'Lignes de départ et fin
L1 = 12
L2 = 133


Set rg = ws1.Range("I8") 'cellule de départ



Set rg3 = ws1.Range("I9") 'cellule de départ




Do Until IsEmpty(rg)


Sheets("Var_FTE_LE2011.09").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"

Sheets("Var_EEP_LE2011.09").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"

'Copie des lignes 12 à 133 dans la colonne V des FTE
Set rgP = ws2.Range("V65536").End(xlUp).Offset(1, 0) 'cellule de destination
Set rgC = Range(ws1.Cells(L1, rg.Column), ws1.Cells(L2, rg.Column))
rgC.Copy rgP

'Copie de la colonne C dans W des FTE/EEP
Set rgC = ws1.Range("C" & L1).Resize(L2 - L1 + 1, 1)
Set rgP = ws2.Range("W" & rgP.Row).Resize(L2 - L1 + 1, 1)
rgC.Copy rgP

'Copie de la colonne D dans Y des FTE/EEP
Set rgC = ws1.Range("D" & L1).Resize(L2 - L1 + 1, 1)
Set rgP = ws2.Range("Y" & rgP.Row).Resize(L2 - L1 + 1, 1)
rgC.Copy rgP

'Copie des lignes 12 à 133 dans la colonne V des EEP
Set rgP = ws2.Range("U65536").End(xlUp).Offset(1, 0) 'cellule de destination
Set rgC = Range(ws3.Cells(L1, rg.Column), ws3.Cells(L2, rg.Column))
rgC.Copy rgP



'Colonne C
ws2.Range("C" & rgP.Row).Resize(L2 - L1 + 1, 1) = rg 'colonne C


Set rg = rg.Offset(0, 1) 'on décale de 1 colonne

'Colonne C
ws2.Range("AI" & rgP.Row).Resize(L2 - L1 + 1, 1) = rg3 'colonne AI


Set rg3 = rg3.Offset(0, 1) 'on décale de 1 colonne


Loop

Application.ScreenUpdating = True



Sheets("Data_Headcount_Magnitude").Select


Columns("C").Select 'copier coller valeur
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Columns("U:W").Select 'copier coller valeur
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Columns("Y").Select 'copier coller valeur
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Columns("AG").Select 'copier coller valeur
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False






End Sub




La MODIFICATION que je veux y apporter, c'est que je veux faire un copier coller des lignes plus à partir de valeur en dure = ligne de départ L1 et ligne de fin L2.
En effet si je dois rajouter des lignes dans mon tableau alors elles ne seront plus prises en compte. Je veux donc faire un code qui dit: de la ligne 11 + 1 à tant qu'il y a pas une cellule vide. (car je sais que la ligne 11 ne bouge jamais).
J'ai essayé de m'inspirer du code des colonnes qui fonctionne comme ca mais je n'y arrive pas.

Merci pour votre aide
 

Pièces jointes

  • copier coller ligne.xls
    206.5 KB · Affichages: 59

Excel-lent

XLDnaute Barbatruc
Re : Faire une boucle mais sans valeur en dure

Bonjour Yannnnick


Sur ton fichier tu as plusieurs tableaux! Ta macro doit traiter que le premier tableau?

Si oui, il te suffit juste de remplacer la ligne :

par

L2 = Range("D12").End(xlDown).Row

Par contre, attention, avec une telle méthode il y a UN soucis, si pour une raison "x" ou "y" dans la colonne D il y a une cellule vide au milieu de ton tableau, tu n'auras que la partie supérieur du tableau de traité par la macro.

Bonne après midi
 

Discussions similaires

Statistiques des forums

Discussions
312 514
Messages
2 089 223
Membres
104 068
dernier inscrit
OLIVIER VERDIERE