Limiter la copie des cellules d'une feuille vers une autre

thierry440

XLDnaute Junior
Bonjour
Dans le code suivant je duplique les enregistrements d'une feuille BDR vers une autre feuille IND ligne par ligne.
Par contre je voudrais limiter la recopie ligne par ligne jusqu'à colonne AD vers la feuille IND

ci-joint le code utilisé :

Dim i2 As Long
Application.ScreenUpdating = False
With Sheets("BDR")
For i2 = .Cells(Rows.Count, "a").End(xlUp).Row To 2 Step -1
If .Range("AA" & i2) Like "Réalisé*" Then
With .Rows(i2)
.Copy Destination:=Sheets("IND").Range("a" & Rows.Count).End(xlUp)(2)
End With
End If
Next
End With

Merci d'avance
 

CPk

XLDnaute Impliqué
Re : Limiter la copie des cellules d'une feuille vers une autre

Bonjour, en remplacement de Rows(i2) essayez de mettre

Code:
Range(.cells(i2,1),.cells(i2,30))
Cela définit la plage allant de la colonne 1 à 30 de la ligne I2 au lieu de la ligne entiere.
 

Robert

XLDnaute Barbatruc
Re : Limiter la copie des cellules d'une feuille vers une autre

Bonjour Thierry, CPK, bonjour le forum,

Une autre proposition peut-être plus rapide :

Code:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (Imcrément)
Dim TL() As Variant 'déclare la variable TL (Tabeau des lignes)

Set OS = Sheets("BDR") 'définit l'onglet source OS
Set OD = Sheets("IND") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV) 'définit le nombre de lignes NL du tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes du tableau des valeurs TV (en partant de la seconde)
    If InStr(1, TV(I, 27), "Réalisé", vbTextCompare) <> 0 Then 'condition si la valeur ligne I, colonne 27 (=> AA) du tableau des valeurs TV contient le mot "Réalisé"
        ReDim Preserve TL(1 To 30, 1 To K) 'redimensionne le tableau des lignes TL (30 lignes, K colonnes)
        For J = 1 To 30 'boucle 2: sur les 30 colonnes du tableau de valeurs TV (=> A à AD)
            TL(J, K) = TV(I, J) 'récupère dans la ligne J colonne K de TL la valeur ligne I colonne J de TV (= Transposition)
        Next J 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (rajoute une colonne au tableau de lignes TL
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si K est supérieur à 1 (donc si il existe au moins une ligne contenant "Réalisé"), renvoie dans A2 (redimensionnée) de l'onglet OD le tableau TL transposé
If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub
 
Haut Bas