Vérifier si cellules sont vides

M

mikael2235

XLDnaute Occasionnel
Bonjour le forum,

J’ai fait une macro qui me recopie des données dans un autre tableau d’un autre fichier.
Ma macro recopie les données du fichier source : cellule E30 + plage cellule E32 à E39 et boucle ceci pour les colonnes E à AE

Par contre, je souhaiterais que ma macro, vérifie avant de recopier qu’il n’y a pas de cellules vides dans la plage x32 à x39, et que si elle détecte que toute la plage x32 à x39 est vide, elle arrête la boucle.

Le problème est que , je ne sais pas comment faire. Je pense que le code ci dessous est adapté, mais lorsque je le mets en place ma boucle ne s’arrête plus.

Code: 
' Selectionne la première cellule du tableau
Range("A1").Select

' Boucle tant que pas de cellule vide
Do While Not (IsEmpty(ActiveCell))
    NbLigne = NbLigne + 1
    Selection.Offset(1, 0).Select
Loop

Je vous joins ma macro, et mon fichier exemple.

Code: 
Sub Carte_Controle_Auto()
 
    '----Ouvre le fichier récap
    Range("A1").Select
    Workbooks.Open Filename:= _
        chemin_fichier_carte_controle
        
        
    '----Affiche la  feuille de données du classeur récap

    'Windows(nom_fichier_carte_controle).Activate
    'Sheets("données").Visible = True
    'ActiveSheet.Unprotect
            
    '----Début de la boucle----
    
    Dim n As Byte
    For n = 5 To 32 Step 2
            
            
    '----Insère 2 lignes et annule la mise en forme----
        
    Windows(nom_fichier_carte_controle).Activate
    Rows("6:6").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Rows("6:7").Select
    Range("A7").Activate
    Selection.RowHeight = 12.75
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A6:L7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("C4").Select
    
    
    '----Copie la date du jour sur fichier récap----
    
    Windows(nom_fichier_carte_controle).Activate
    Range("A6").Value = Date
    Windows(nom_fichier_feuille_releves).Activate
                   
    '----Copie l'heure de la moulée----
    
    Cells(30, n).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(nom_fichier_carte_controle).Activate
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
             
    '----Copie les 8 valeurs (CB1 à CB4 × 2 moulées)dans tableau récap----
    
    Windows(nom_fichier_feuille_releves).Activate
    Cells(30, n).Select
    ActiveCell.Offset(2, 0).Resize(8).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(nom_fichier_carte_controle).Activate
    Range("D6").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A8").Select
    Windows(nom_fichier_feuille_releves).Activate
    ActiveWindow.ScrollRow = 1
    Range("G10").Select
    
    'Supprime la ligne en trop, et recopie les limites, tolérances et la cible
    
    Windows(nom_fichier_carte_controle).Activate
    Rows("7:7").Select
    Selection.Delete Shift:=xlUp
    Range("A6:L6").Select
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "helv"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("M7:Q7").Select
    Selection.AutoFill Destination:=Range("M6:Q7"), Type:=xlFillDefault
    Range("M6:Q7").Select
    ActiveWindow.ScrollColumn = 1
    Range("B11").Select
    
    Next
     
    '---- Enregistre le classeur de récap des données
    
    Windows(nom_fichier_carte_controle).Activate
    ActiveWorkbook.Close
    
  
End Sub

Merci pour votre aide.
 

Pièces jointes

  • Classeur2.xls
    25 KB · Affichages: 102
  • Classeur2.xls
    25 KB · Affichages: 106
  • Classeur2.xls
    25 KB · Affichages: 91
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Vérifier si cellules sont vides

Bonjour Mikael, bonjour le forum,

J'avoue que je n'ai pas bien compris tes explications... Je te propose de tester si la somme de la plage 32:39 est différente de 0 alors la copie se fait. En espérant que c'est bien ça....
Ci-dessous une partie de ton code avec en rouge ce que j'ai rajouté :
Code: 
    '----Copie l'heure de la moulée----
[COLOR=red]   If Application.WorksheetFunction.Sum(Cells(32, n), Cells(39, n)) <> 0 Then[/COLOR]
    
        Cells(30, n).Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(nom_fichier_carte_controle).Activate
        Range("B6").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
 
        '----Copie les 8 valeurs (CB1 à CB4 × 2 moulées)dans tableau récap----
 
        Windows(nom_fichier_feuille_releves).Activate
        Cells(30, n).Select
        ActiveCell.Offset(2, 0).Resize(8).Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(nom_fichier_carte_controle).Activate
        Range("D6").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Range("A8").Select
        Windows(nom_fichier_feuille_releves).Activate
        ActiveWindow.ScrollRow = 1
        Range("G10").Select
 
        'Supprime la ligne en trop, et recopie les limites, tolérances et la cible
 
        Windows(nom_fichier_carte_controle).Activate
        Rows("7:7").Select
        Selection.Delete Shift:=xlUp
        Range("A6:L6").Select
        Selection.Font.Bold = False
        With Selection.Font
            .Name = "helv"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        Range("M7:Q7").Select
        Selection.AutoFill Destination:=Range("M6:Q7"), Type:=xlFillDefault
        Range("M6:Q7").Select
        ActiveWindow.ScrollColumn = 1
        Range("B11").Select
 
[COLOR=red]   End If[/COLOR]
    Next
 
    '---- Enregistre le classeur de récap des données
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Vérifier si cellules sont vides

Bonjour mikael2235, Robert
Pour ma part j'ai testé
Code: 
[COLOR="DarkSlateGray"][B]Sub toto()
' Selectionne la première cellule du tableau
Range("X32").Select

' Boucle tant que pas de cellule vide
Do While Not (IsEmpty(ActiveCell))
    NbLigne = NbLigne + 1
    Selection.Offset(1, 0).Select
Loop

End Sub[/B][/COLOR]
sans souci dans le classeur d'essai.​
ROGER2327
#3425

17 Floréal An CCXVIII
2010-W18-4T11:21:07Z
 
Vote positif 0 Vote négatif
M

mikael2235

XLDnaute Occasionnel
Re : Vérifier si cellules sont vides

ROGER2327 à dit:
Bonjour mikael2235, Robert
Pour ma part j'ai testé
Code: 
[COLOR="DarkSlateGray"][B]Sub toto()
' Selectionne la première cellule du tableau
Range("X32").Select

' Boucle tant que pas de cellule vide
Do While Not (IsEmpty(ActiveCell))
    NbLigne = NbLigne + 1
    Selection.Offset(1, 0).Select
Loop

End Sub[/B][/COLOR]
sans souci dans le classeur d'essai.​
ROGER2327
#3425

17 Floréal An CCXVIII
2010-W18-4T11:21:07Z
Cliquez pour agrandir...

Merci Roger, mais a quel endroit je dois l'insérer ? parce que j'ai essayé mais ça n'a pas marché !
 
Vote positif 0 Vote négatif
M

mikael2235

XLDnaute Occasionnel
Re : Vérifier si cellules sont vides

Robert à dit:
Bonjour Mikael, bonjour le forum,

J'avoue que je n'ai pas bien compris tes explications... Je te propose de tester si la somme de la plage 32:39 est différente de 0 alors la copie se fait. En espérant que c'est bien ça....
Ci-dessous une partie de ton code avec en rouge ce que j'ai rajouté :
Code: 
    '----Copie l'heure de la moulée----
[COLOR=red]   If Application.WorksheetFunction.Sum(Cells(32, n), Cells(39, n)) <> 0 Then[/COLOR]
    
        Cells(30, n).Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(nom_fichier_carte_controle).Activate
        Range("B6").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
 
        '----Copie les 8 valeurs (CB1 à CB4 × 2 moulées)dans tableau récap----
 
        Windows(nom_fichier_feuille_releves).Activate
        Cells(30, n).Select
        ActiveCell.Offset(2, 0).Resize(8).Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(nom_fichier_carte_controle).Activate
        Range("D6").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Range("A8").Select
        Windows(nom_fichier_feuille_releves).Activate
        ActiveWindow.ScrollRow = 1
        Range("G10").Select
 
        'Supprime la ligne en trop, et recopie les limites, tolérances et la cible
 
        Windows(nom_fichier_carte_controle).Activate
        Rows("7:7").Select
        Selection.Delete Shift:=xlUp
        Range("A6:L6").Select
        Selection.Font.Bold = False
        With Selection.Font
            .Name = "helv"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        Range("M7:Q7").Select
        Selection.AutoFill Destination:=Range("M6:Q7"), Type:=xlFillDefault
        Range("M6:Q7").Select
        ActiveWindow.ScrollColumn = 1
        Range("B11").Select
 
[COLOR=red]   End If[/COLOR]
    Next
 
    '---- Enregistre le classeur de récap des données
Cliquez pour agrandir...

Merci Robert,

ça fonctionne comme ça, somme différente de 0, c'est ok.

Mais par contre si une plage de x32 à x39 est vide, alors il va quand même me faire 'insere 2 lignes et 'copie la date du jour.

J'ai essayé en mettant ta ligne If juste aprés le début de ma boucle, mais il me renvoie une erreur "Next sans For" !

Merci encore
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Vérifier si cellules sont vides

Bonjour le fil, bonjour le forum,

Essaie de la déplacer juste après l'initialisation de la boucle :
Code: 
Dim n As Byte
    For n = 5 To 32 Step 2
[COLOR=red]If...[/COLOR]
 
Vote positif 0 Vote négatif
M

mikael2235

XLDnaute Occasionnel
Re : Vérifier si cellules sont vides

Robert à dit:
Bonjour le fil, bonjour le forum,

Essaie de la déplacer juste après l'initialisation de la boucle :
Code: 
Dim n As Byte
    For n = 5 To 32 Step 2
[COLOR=red]If...[/COLOR]
Cliquez pour agrandir...

Excuse moi Robert de ne pas t'avoir répondu plus tôt.

Alors en fait quand je mettais le If ou tu l'as mis ça me faisait une erreur : Next sans For parce que j'avais omis le End If.

Par contre j'ai changé un peu la condition :
Code: 
    If IsEmpty(Cells(32, n)) = False Then

Et quand j'éxecutais ma macro il s'arretait toujours à la même colonne alors que la cellule 32 de cette colonne n'était pas vide. J'ai trouvé après beaucoup de temps.
Il était sur une autre feuille au moment ou je lui demandais ceci.

C'est "réparé" et tout fonctionne.

Merci encore pour ton & votre aide
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
599
Kevin38
K
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
305
vgendron
vgendron
L
  • Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
391
lolo_excelbeginner
L
M
  • Question
Microsoft 365 VBA fusion défusion cellule gestion cellules
Réponses
8
Affichages
259
mix770
M
Syracoti
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
Staple1600
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
568
mouchtre
mouchtre
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
390
M@xu3L
M

Membres actuellement en ligne

2 membres et 35 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 429
Messages
2 088 350
Membres
103 823
dernier inscrit
ben talha redouane