Problème de code

Le 29/03/2015 à 00:33

Bonsoir,

J'ai un petit problème avec ce code, je n'ai rien qui arrive en "feuil4" mais je ne comprends pas pourquoi ???

Sub selection_ligne()

Dim i As Integer, Compteur As Integer, jour As Date

jour = Range("A3")

Application.ScreenUpdating = False

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row

If Cells(i, 1) = jour Then

Compteur = Compteur + 1

Rows(i).Copy Destination:=Sheets("feuil3").Range("A" & Compteur)

ElseIf Cells(i, 1) = jour + 1 Then

Compteur = Compteur + 1

Rows(i).Copy Destination:=Sheets("feuil4").Range("A" & Compteur)

End If

Next i

Sheets("feuil4").Select

End Sub

Merci de votre aide

Le 29/03/2015 à 04:24

Bonjour, chez moi ça fonctionne si ce n'est qu'à mon sens vous devriez utiliser 2 compteurs différents étant donné qu'il s'incrémente à chaque fois, vous aurez donc des sauts de lignes sur chaque feuille.

Si vous souhaitez plus de détails, il faudra mettre votre fichier pour qu'on puisse regarder plus précisément.

Le 29/03/2015 à 08:36

Bonjour,

Alors oui ça fonctionne, je viens de le voir désolé..... mais je pensais que ça collerait en A1, c'est pour ça que je ne le voyais pas.

Je vous joins un fichier.

Ce que je voulais faire :

Dans la feuil1, c'est avoir dans les colonnes A à D toutes les lignes de la 1ère date dans les colonnes F à I toutes les lignes de la date +1, dans K à N celles de date +2, dans P à S celles de date +3, dans U à X celles de date +4, dans Z à AC celles de date +5 et dans AE à AH celles de date+6.

Mais comme je n'y arrivais pas j'ai essayer en mettant chaque jour dans un nouvel onglet. Du coup mon code y arrive mais pas parfaitement soit il faudrait le modifier pour que les lignes soient collées en A1 soit je rajoute une suppression de lignes vides ??

Merci de votre aide

8commandes.xlsm (42.53 Ko)
Le 29/03/2015 à 08:55

Bonjour,

Un exemple à tester.

Cdlt.

Sub selection_ligne_2()
Dim i As Integer, Compteur1 As Integer, Compteur2 As Integer
Dim jour As Date

    Application.ScreenUpdating = False
    jour = Range("A3")
    Compteur1 = 1: Compteur2 = 1

    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(i, 1) = jour Then
            Rows(i).Copy Destination:=Sheets("feuil3").Range("A" & Compteur1)
            Compteur1 = Compteur1 + 1
        Else
            Cells(i, 1) = jour + 1
            Rows(i).Copy Destination:=Sheets("feuil4").Range("A" & Compteur2)
            Compteur2 = Compteur2 + 1
        End If
    Next i

    Sheets("feuil4").Select

End Sub
Le 29/03/2015 à 09:05

Bonjour,

Merci pour la réactivité.

Il colle bien en A1 mais il change les dates d'après en feuil1 et donc colle toutes les lignes.

Le 29/03/2015 à 15:08

A tester, un exemple avec tous les résultat en Feuil2

Sub test()
Dim jour As Date
Dim i, compteur As Integer
Dim Ws As Worksheet

Set Ws = Sheets("Feuil2")

With Sheets("Feuil1")

jour = .Cells(1, 1)

    For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
        If .Cells(i, 1) = jour Then
            compteur = Ws.Range("A" & Rows.Count).End(xlUp).Row + 1
            Ws.Cells(compteur, 1) = Format(.Cells(i, 1), "dd/mm/yyyy")
            Ws.Cells(compteur, 2) = .Cells(i, 2)
            Ws.Cells(compteur, 3) = .Cells(i, 3)
            Ws.Cells(compteur, 4) = .Cells(i, 4)
        ElseIf .Cells(i, 1) = (jour + 1) Then
            compteur = Ws.Range("F" & Rows.Count).End(xlUp).Row + 1
            Ws.Cells(compteur, 6) = Format(.Cells(i, 1), "dd/mm/yyyy")
            Ws.Cells(compteur, 7) = .Cells(i, 2)
            Ws.Cells(compteur, 8) = .Cells(i, 3)
            Ws.Cells(compteur, 9) = .Cells(i, 4)
        ElseIf .Cells(i, 1) = (jour + 2) Then
            compteur = Ws.Range("K" & Rows.Count).End(xlUp).Row + 1
            Ws.Cells(compteur, 11) = Format(.Cells(i, 1), "dd/mm/yyyy")
            Ws.Cells(compteur, 12) = .Cells(i, 2)
            Ws.Cells(compteur, 13) = .Cells(i, 3)
            Ws.Cells(compteur, 14) = .Cells(i, 4)
        ElseIf .Cells(i, 1) = (jour + 3) Then
            compteur = Ws.Range("P" & Rows.Count).End(xlUp).Row + 1
            Ws.Cells(compteur, 16) = Format(.Cells(i, 1), "dd/mm/yyyy")
            Ws.Cells(compteur, 17) = .Cells(i, 2)
            Ws.Cells(compteur, 18) = .Cells(i, 3)
            Ws.Cells(compteur, 19) = .Cells(i, 4)
        ElseIf .Cells(i, 1) = (jour + 4) Then
            compteur = Ws.Range("U" & Rows.Count).End(xlUp).Row + 1
            Ws.Cells(compteur, 21) = Format(.Cells(i, 1), "dd/mm/yyyy")
            Ws.Cells(compteur, 22) = .Cells(i, 2)
            Ws.Cells(compteur, 23) = .Cells(i, 3)
            Ws.Cells(compteur, 24) = .Cells(i, 4)
        ElseIf .Cells(i, 1) = (jour + 5) Then
            compteur = Ws.Range("Z" & Rows.Count).End(xlUp).Row + 1
            Ws.Cells(compteur, 26) = Format(.Cells(i, 1), "dd/mm/yyyy")
            Ws.Cells(compteur, 27) = .Cells(i, 2)
            Ws.Cells(compteur, 28) = .Cells(i, 3)
            Ws.Cells(compteur, 29) = .Cells(i, 4)
        ElseIf .Cells(i, 1) = (jour + 6) Then
            compteur = Ws.Range("AE" & Rows.Count).End(xlUp).Row + 1
            Ws.Cells(compteur, 31) = Format(.Cells(i, 1), "dd/mm/yyyy")
            Ws.Cells(compteur, 32) = .Cells(i, 2)
            Ws.Cells(compteur, 33) = .Cells(i, 3)
            Ws.Cells(compteur, 34) = .Cells(i, 4)
        End If
    Next i

End With

Set Ws = Nothing

End Sub

Dans cette macro, la liste est dans Feuil1 comme dans ton fichier.

Dans Feuil2 on obtient toutes les 5 colonnes la liste des 6 dates.

Je n'ai pas utilisé le copier/coller dans cette macro, mais c'est tout à fait possible de le faire pour réduire la longueur du code.

EDIT : il y avait une erreur dans les 4 dernières colonnes de ce code, je viens de la corriger.

Le 29/03/2015 à 15:31

Merci, il marche bien

Le 29/03/2015 à 15:42

En "simplifiant" (remplacement des if et elseif par des case) et en utilisant le copier / coller

Sub test2()
Dim jour As Date
Dim i, compteur As Integer
Dim Ws As Worksheet

Set Ws = Sheets("Feuil2")

Application.ScreenUpdating = False

With Sheets("Feuil1")
jour = .Cells(1, 1)

    For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
        Select Case .Cells(i, 1)
            Case jour
                compteur = Ws.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":D" & i).Copy Destination:=Ws.Cells(compteur, "A")
            Case jour + 1
                compteur = Ws.Range("F" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":D" & i).Copy Destination:=Ws.Cells(compteur, "F")
            Case jour + 2
                compteur = Ws.Range("K" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":D" & i).Copy Destination:=Ws.Cells(compteur, "K")
            Case jour + 3
                compteur = Ws.Range("P" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":D" & i).Copy Destination:=Ws.Cells(compteur, "P")
            Case jour + 4
                compteur = Ws.Range("U" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":D" & i).Copy Destination:=Ws.Cells(compteur, "U")
            Case jour + 5
                compteur = Ws.Range("Z" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":D" & i).Copy Destination:=Ws.Cells(compteur, "Z")
            Case jour + 6
                compteur = Ws.Range("AE" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & i & ":D" & i).Copy Destination:=Ws.Cells(compteur, "AE")

        End Select
    Application.CutCopyMode = False
    Next i

End With

Application.ScreenUpdating = True

Set Ws = Nothing

End Sub
Le 29/03/2015 à 15:59

Si tu as beaucoup de ligne il pourrait être judicieux de remplacer integer par long

Dim i, compteur As Integer --> Dim i, compteur As long

De mémoire, il me semble d'ailleurs avoir lu quelque part que les versions récentes d'excel convertissent en interne les variables integer en long, il serait donc préférable si c'est vrai (je n'ai pas retrouvé la doc ou j'ai lu ça) et étant donné que tu utilise une version 2010 de mettre de base long, même si dans ton cas ça ne fera pas grand différence.

D'ailleurs en passant si quelqu'un a une info la dessus...

Le 29/03/2015 à 16:06

Merci beaucoup !!!

J'avais remarqué l'erreur sur ton 1er test que j'avais corrigé.

L'utilisation du copier/collé dans ton 2è test est bien plus rapide à exécuter !!!

Je vais essayer avec "long"

Encore merci

Rechercher des sujets similaires à "probleme code"