Excel vba recopie cellules

Résolu/Fermé

marcoturbo Messages postés 26 Date d'inscription jeudi 4 septembre 2014 Statut Membre Dernière intervention 13 janvier 2016 - Modifié par marcoturbo le 3/06/2015 à 15:31
marcoturbo Messages postés 26 Date d'inscription jeudi 4 septembre 2014 Statut Membre Dernière intervention 13 janvier 2016 - 3 juin 2015 à 19:46

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..)


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.

A voir également:

Excel vba recopie cellules
Liste déroulante excel - Guide
Excel additionner des cellules - Guide
Verrouiller cellules excel - Guide
Formule excel - Guide
Aller à la ligne dans une cellule excel - Guide

3 réponses

Réponse 1 / 3

Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
3 juin 2015 à 15:33

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+

Réponse 2 / 3

marcoturbo Messages postés 26 Date d'inscription jeudi 4 septembre 2014 Statut Membre Dernière intervention 13 janvier 2016
3 juin 2015 à 15:42

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.

Réponse 3 / 3

Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
3 juin 2015 à 16:38

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+

marcoturbo Messages postés 26 Date d'inscription jeudi 4 septembre 2014 Statut Membre Dernière intervention 13 janvier 2016
3 juin 2015 à 19:46

un grand merci ;)

Discussions similaires

Formule Excel : "SI" une cellule contient un mot, alors ?

Discussions similaires

Newsletters