IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Problème Copier vers le bas sous excel (Débutant en VBA) [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Août 2017
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 32
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Août 2017
    Messages : 13
    Par défaut Problème Copier vers le bas sous excel (Débutant en VBA)
    Bonjour,
    Je m'adresse à vous si vous pouvez me régler ce petit problème. Cherchant à faire un copier vers vers le bas sous excel, j'ai trouvé une macro sur internet qui permet de remplir les cellules vides de chaque colonne avec les valeurs de la cellule remplie qui précède, mais le problème c'est que pour certaines colonnes dont la première ligne est vide il fait un copier de l'entête de la colonne. Alors j'aimerais bien savoir s'il y'a quelqu'un qui pourrait m'aider sur ce problème et je lui serais reconnaissant. Merci d'avance.

    Voilà le code VBA, si jamais y'a quelqu'un qui peut rajouter une petite modification pour éviter ce problème.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    Sub FillColBlanksSpecial()
     
    Dim wks As Worksheet
    Dim rng As Range
    Dim rng2 As Range
    Dim LastRow As Long
    Dim col As Long
    Dim lRows As Long
    Dim lLimit As Long
     
    Dim lCount As Long
    On Error Resume Next
     
    lRows = 2 'starting row
    lLimit = 8000
     
    Set wks = ActiveSheet
    With wks
       col = ActiveCell.Column
     
       Set rng = .UsedRange  'try to reset the lastcell
       LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
       Set rng = Nothing
     
        lCount = .Columns(col).SpecialCells(xlCellTypeBlanks).Areas(1).Cells.Count
     
        If lCount = 0 Then
            MsgBox "No blanks found in selected column"
            Exit Sub
        ElseIf lCount = .Columns(col).Cells.Count Then
            MsgBox "Over the Special Cells Limit" 'this line can be deleted
            Do While lRows < LastRow
                Set rng = .Range(.Cells(lRows, col), .Cells(lRows + lLimit, col)) _
                               .Cells.SpecialCells(xlCellTypeBlanks)
                rng.FormulaR1C1 = "=R[-1]C"
                lRows = lRows + lLimit
            Loop
        Else
            Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
                           .Cells.SpecialCells(xlCellTypeBlanks)
            rng.FormulaR1C1 = "=R[-1]C"
        End If
     
       'replace formulas with values
       With .Cells(1, col).EntireColumn
           .Value = .Value
       End With
     
    End With
     
    End Sub


    Nom : Untitled.png
Affichages : 191
Taille : 11,2 Ko

  2. #2
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Faicel.93 Voir le message
    A tester :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
     
    Sub RemplirLesCellulesVides(ByVal FeuilleEnCours As Worksheet, ByVal LigneDeTitre As Long, ByVal LigneLimite As Long, ByVal ColonneEnCours As Long)
     
    Dim DerniereLigne As Long, LigneEnCours As Long
    Dim ValeurEnCours As Variant
     
            With FeuilleEnCours
                 DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
                 If DerniereLigne < LigneLimite Then LigneLimite = DerniereLigne
     
                 If .Cells(LigneDeTitre + 1, ColonneEnCours) = "" Then
                    ValeurEnCours = "Sans info"
                    .Cells(LigneDeTitre + 1, ColonneEnCours) = ValeurEnCours
                 Else
                    ValeurEnCours = .Cells(LigneDeTitre + 1, ColonneEnCours)
                 End If
     
                 For LigneEnCours = LigneDeTitre + 1 To LigneLimite
                     If LigneEnCours < LigneLimite Then
                        Select Case .Cells(LigneEnCours + 1, ColonneEnCours)
                               Case ValeurEnCours
     
                               Case ""
                                    .Cells(LigneEnCours + 1, ColonneEnCours) = ValeurEnCours
                               Case Else
                                    ValeurEnCours = .Cells(LigneEnCours + 1, ColonneEnCours)
                        End Select
                     End If
                 Next LigneEnCours
            End With
     
    End Sub
     
     
    Sub TestRemplirLesCellulesVides()
     
    Dim MaLigneDeTitre As Long, MaLigneLimite As Long, MaColonneEnCours As Long
     
        MaLigneDeTitre = 1
        MaLigneLimite = 8000
        MaColonneEnCours = 1
     
        RemplirLesCellulesVides ActiveSheet, MaLigneDeTitre, MaLigneLimite, MaColonneEnCours
     
    End Sub

  3. #3
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Août 2017
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 32
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Août 2017
    Messages : 13
    Par défaut
    Merci Eric, ça a marché mais juste pour la première colonne, dès que j'essaye d'appliquer la macro pour les autres colonnes elle ne mache pas, vous n'avez pas une idée sur celà ? Merci par avance.

  4. #4
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Faicel.93 Voir le message
    Ben non ! en changeant les paramètres TestRemplirLesCellulesVides, ça va fonctionner.

  5. #5
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Août 2017
    Messages
    13
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 32
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Août 2017
    Messages : 13
    Par défaut
    Merci beaucoup Erik ça a marché sauf pour les colonnes qui commencent avec un 0 il ne recopie pas les 0 mais les autres valeurs, aussi j'aimerais savoir s'il y a un moyen pour ne pas modifier dans le code à chaque fois est de faire l'opération de façon automatique pour toutes colonnes une fois la macro exécutée.
    Merci infiniment pour votre retour.

  6. #6
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par Faicel.93 Voir le message
    J'ai modifié la macro RemplirLesCellulesVides. En effet, lorsqu'on avait 0, rien ne se dupliquait. En revanche, le reste était bon. J'en ai déduit que les cellules restant vides ne pouvaient correspondre qu'à des 0. Il y a donc une deuxième boucle à la fin pour traiter ce cas.
    Quant à traiter X colonnes, il suffit de rajouter une boucle dans TestRemplirLesCellulesVides

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
     
    Sub RemplirLesCellulesVides(ByVal FeuilleEnCours As Worksheet, ByVal LigneDeTitre As Long, ByVal LigneLimite As Long, ByVal ColonneEnCours As Long)
     
    Dim DerniereLigne As Long, LigneEnCours As Long
    Dim ValeurEnCours As Variant
     
            With FeuilleEnCours
                 DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
                 If DerniereLigne < LigneLimite Then LigneLimite = DerniereLigne
     
                 ' Initialisation de ValeurEnCours
                 Select Case .Cells(LigneDeTitre + 1, ColonneEnCours).Value
                        Case ""
                            ValeurEnCours = "Sans info"
                            .Cells(LigneDeTitre + 1, ColonneEnCours) = ValeurEnCours
     
                        Case 0, "0"
     
                       Case Else
                             ValeurEnCours = .Cells(LigneDeTitre + 1, ColonneEnCours)
                 End Select
                 ' 1er balayage pour mettre à jour les valeurs "" avec ValeurEnCours
                 ' les valeurs 0 ne sont pas prises en compte
                 For LigneEnCours = LigneDeTitre + 1 To LigneLimite
                     Select Case .Cells(LigneEnCours, ColonneEnCours)
                            Case ValeurEnCours
     
                            Case ""
                                 .Cells(LigneEnCours, ColonneEnCours) = ValeurEnCours
                            Case Else
                                 ValeurEnCours = .Cells(LigneEnCours, ColonneEnCours)
                        End Select
                 Next LigneEnCours
                 ' 2ème balayage pour mettre à jour les valeurs 0
                 For LigneEnCours = LigneDeTitre + 1 To LigneLimite
                     Select Case .Cells(LigneEnCours, ColonneEnCours)
                            Case ""
                                 .Cells(LigneEnCours, ColonneEnCours) = 0
                     End Select
                 Next LigneEnCours
            End With
     
    End Sub
     
    Sub TestRemplirLesCellulesVides()
     
    Dim MaLigneDeTitre As Long, MaLigneLimite As Long, MaColonneEnCours As Long
     
        MaLigneDeTitre = 1
        MaLigneLimite = 8000
       ' MaColonneEnCours = 7
     
        For MaColonneEnCours = 1 To 7  ' A adapter 
        RemplirLesCellulesVides ActiveSheet, MaLigneDeTitre, MaLigneLimite, MaColonneEnCours
     
        Next MaColonneEnCours
     
    End Sub
    Dernière modification par Invité ; 16/08/2017 à 12h35.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [css] Décalage de 2 pixels vers le bas sous ie6
    Par tofito dans le forum Mise en page CSS
    Réponses: 4
    Dernier message: 13/10/2008, 15h09
  2. copier une feuille excel vers un autre fichier excel en access VBA
    Par acbdev dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 19/03/2008, 09h32
  3. Page un peu décaler vers le bas sous IE
    Par paradeofphp dans le forum Mise en page CSS
    Réponses: 3
    Dernier message: 03/02/2008, 12h40
  4. Décalage vers le bas sous IE
    Par Fugugirl dans le forum Mise en page CSS
    Réponses: 2
    Dernier message: 21/11/2006, 11h23
  5. [VBA-E] Problème de dépassement de capacité sous Excel
    Par Nicolas67 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 30/05/2006, 10h36

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo