Excel vba recopie cellules
Résolu
Bonjour,
j'ai un petit soucis avec le fichier joint.
https://www.cjoint.com/c/EFdmHt8iTa4
Je voudrais que lors de la copie, les résultats s'affichent sur la même page. ( le premier résultat en colonne A, le second en colonne F, le troisième en colonne K, etc..)
j'ai essayer en changeant le range mais ça marche pas.
merci d'avance.
j'ai un petit soucis avec le fichier joint.
https://www.cjoint.com/c/EFdmHt8iTa4
Je voudrais que lors de la copie, les résultats s'affichent sur la même page. ( le premier résultat en colonne A, le second en colonne F, le troisième en colonne K, etc..)
cel.Resize(, 3).Copy Destination:=Sheets("Feuil6").Cells(Sheets("Feuil6").Range("A65536").End(xlUp).Row + 1, 1)
j'ai essayer en changeant le range mais ça marche pas.
merci d'avance.
3 réponses
-
Bonjour,
Essaie comme cela :Sub Transfert()
Dim Cel As Range, DerLig As Long
Sheets("feuil3").Range("A:D").ClearContents
Sheets("feuil6").Range("F:I").ClearContents
Sheets("feuil7").Range("K:N").ClearContents
With Sheets("Feuil5")
DerLig = .Cells(Rows.Count, 1).End(xlUp).Row
For Each Cel In .[A1].Resize(DerLig)
If Cel.Value > 1000 And Cel.Value < 1250 Then
If Cel.Offset(, 2) = "Hall Sportif de 18H45 A 20H15" Then
Cel.Resize(, 3).Copy Destination:=Sheets("Feuil6").Cells(Sheets("Feuil6").Range("A65536").End(xlUp).Row + 1, "A")
End If
End If
If Cel.Value > 2000 And Cel.Value < 2250 Then
If Cel.Offset(, 2) = "Hall Sportif de 16H30 A 18H00" Then
Cel.Resize(, 3).Copy Destination:=Sheets("Feuil6").Cells(Sheets("Feuil6").Range("F65536").End(xlUp).Row + 1, "F")
End If
End If
Next Cel
End With
End Sub
A+ -
merci gyrus, ca marche.
par la meme occasion, ca me colle a partir de la 2eme ligne, comment faire pour l'avoir sur la premiere?
merci. -
Voici ton code modifié
Sub Transfert()
Dim CelS As Range, CelC As Range
Dim DerLig As Long, Ligne As Long
Sheets("feuil6").Range("A:D,F:I,K:N").ClearContents
With Sheets("Feuil5")
DerLig = .Cells(Rows.Count, 1).End(xlUp).Row
For Each CelS In .[A1].Resize(DerLig)
If CelS.Value > 1000 And CelS.Value < 1250 Then
If CelS.Offset(, 2) = "Hall Sportif de 18H45 A 20H15" Then
Set CelC = Sheets("Feuil6").Range("A" & Rows.Count).End(xlUp)
If CelC.Row = 1 And CelC.Value = "" Then
CelS.Resize(, 3).Copy Sheets("Feuil6").Range("A" & Rows.Count).End(xlUp)
Else
CelS.Resize(, 3).Copy Sheets("Feuil6").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End If
End If
If CelS.Value > 2000 And CelS.Value < 2250 Then
If CelS.Offset(, 2) = "Hall Sportif de 16H30 A 18H00" Then
Set CelC = Sheets("Feuil6").Range("F" & Rows.Count).End(xlUp)
If CelC.Row = 1 And Cel.Value = "" Then
CelS.Resize(, 3).Copy Sheets("Feuil6").Range("F" & Rows.Count).End(xlUp)
Else
CelS.Resize(, 3).Copy Sheets("Feuil6").Range("F" & Rows.Count).End(xlUp).Offset(1)
End If
End If
End If
Next CelS
End With
End Sub
A+
