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 :

Boucle avec une condition


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Profil pro
    Inscrit en
    Avril 2004
    Messages
    154
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2004
    Messages : 154
    Par défaut Boucle avec une condition
    Bonjour
    Je vous présente d'abord ma situation.
    J'ai un grand nombre de classeurs excel, avec à l'intérieur une ou plusieurs feuilles dont le nom commence par "Synt".
    Sur un nouveau classeur, je récupère des informations présentes sur des cellules fixes de chaque feuille commençant par "Synt" de chaque classeur.
    J'ai un macro qui fonctionne bien, mais je rencontre maintenant un problème si toutefois une cellule que je veux recopier est vide.
    Ma macro copie les valeurs des cellules en question, et les colle dans les colonnes du nouveau tableau dans les premières lignes vides.
    Et c'est là le problème, dans le cas où une cellule serait vide, cela aura pour conséquence de créer un décalage dans le tableau récap.

    Mon idée, mais c'est ici que j'ai besoin de vous, c'est de rajouter une condition. Si la valeur est vide, alors on met "Manque prix", et ensuite la macro recopiera donc "Manque prix" au lieu de "vide".

    Voici le code de ma macro, que j'ai coupé un peu car c'est toujours le même code pour chaque valeur à aller chercher.

    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
    Sub general()
        Application.ScreenUpdating = False
     
        'remplit les en-tete
        With ThisWorkbook.Sheets(1)
        .Cells(1, 1) = "Client"
        .Cells(1, 2) = "Référence"
        .Cells(1, 3) = "Désignation"
        .Cells(1, 4) = "Forme Galénique"
        .Cells(1, 5) = "TDL"
        .Cells(1, 6) = "Prix de vente cible"
        .Cells(1, 7) = "Prix de vente client"
     
        End With
     
        'declaration de variable
        Dim objFSO As Object
        Dim objDossier As Object
        Dim objFichier As Object
     
        'initialisation des variables
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'definit le repertoire ou se trouvent les feuilles a traiter
        Set objDossier = objFSO.GetFolder("C:\Test\Fiches")
     
        'pour chaque classeur dans le répertoire
        For Each objFichier In objDossier.Files
            'ouvre le classeur
            Workbooks.Open objFichier
     
           Dim xlwksheet As Worksheet
     
      For Each xlwksheet In ActiveWorkbook.Sheets
        If xlwksheet.Name Like "Synt*" Then
          With xlwksheet
     
        'copie et colle le client
            .Range("C2").Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("a65536").End(xlUp).Row + 1
            .Range("a" & DerLigne).PasteSpecial Paste:=xlPasteValues
            End With
     
        'copie et colle la référence
            .Range("C3").Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("b65536").End(xlUp).Row + 1
            .Range("b" & DerLigne).PasteSpecial Paste:=xlPasteValues
            End With
     
       idem pour les autres champ
     
     
          End With
        End If
      Next




    Et voici ce que j'ai commencé à faire, mais cela ne fonctionne que pour la 1ère feuille du 1er classeur. Je cherche à lui dire de passer sur TOUTES les feuilles commençant par "Synt" de TOUS les classeurs, et que si la cellule D48 est vide, alors il remplace par "Manque prix"

    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
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    Sub general()
        Application.ScreenUpdating = False
        
        'remplit les en-tete
        With ThisWorkbook.Sheets(1)
        .Cells(1, 1) = "Client"
        .Cells(1, 2) = "Référence"
        .Cells(1, 3) = "Désignation"
        .Cells(1, 4) = "Forme Galénique"
        .Cells(1, 5) = "TDL"
        .Cells(1, 6) = "Prix de vente cible"
        .Cells(1, 7) = "Prix de vente client"
    
        End With
        
        'declaration de variable
        Dim objFSO As Object
        Dim objDossier As Object
        Dim objFichier As Object
        
        'initialisation des variables
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'definit le repertoire ou se trouvent les feuilles a traiter
        Set objDossier = objFSO.GetFolder("C:\TestAnthony\Fiche Pileje Industrie")
        
        'pour chaque classeur dans le répertoire
        For Each objFichier In objDossier.Files
            'ouvre le classeur
            Workbooks.Open objFichier
            
           Dim xlwksheet As Worksheet
     
      For Each xlwksheet In ActiveWorkbook.Sheets
        If xlwksheet.Name Like "Synt*" Then
          With xlwksheet
                
        'copie et colle le client
            .Range("C2").Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("a65536").End(xlUp).Row + 1
            .Range("a" & DerLigne).PasteSpecial Paste:=xlPasteValues
            End With
            
        'copie et colle la référence
            .Range("C3").Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("b65536").End(xlUp).Row + 1
            .Range("b" & DerLigne).PasteSpecial Paste:=xlPasteValues
            End With
       
       idem pour les autres champ
            
        'copie et colle le Prix de vente client
           
           .Range("d48").Copy
           If IsEmpty(Range("d48")) Then
                Range("d48") = "Manque prix"
            End If
            
           
            Range("d48").Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("g65536").End(xlUp).Row + 1
            .Range("g" & DerLigne).PasteSpecial Paste:=xlPasteValues
            End With
                  
                  
          End With
        End If
      Next
    Je vous remercie d'avance pour votre aide.

  2. #2
    Expert confirmé Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    Décembre 2013
    Messages
    2 974
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : Décembre 2013
    Messages : 2 974
    Par défaut
    bonjour
    et si après le copiage du prix tu vérifie si la valeur est vide à ce moment tu écris "manque prix"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
     .Range("d48").Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("d65536").End(xlUp).Row + 1
            .Range("d" & DerLigne).PasteSpecial Paste:=xlPasteValues
    ' ce qui tu ajoute :
     
    if   .Range("d" & DerLigne)="" then .Range("d" & DerLigne)="manque prix"
     
     
            End With
    à tester

  3. #3
    Membre confirmé
    Profil pro
    Inscrit en
    Avril 2004
    Messages
    154
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2004
    Messages : 154
    Par défaut
    Merci beaucoup Bennasr, cela fonctionne.

    J'aurai dû prendre le problème à l'envers.

    Merci encore !

  4. #4
    Membre confirmé
    Profil pro
    Inscrit en
    Avril 2004
    Messages
    154
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2004
    Messages : 154
    Par défaut
    Je reviens sur cette discussion.

    En plus, j'aurai bien aimé récupérer le nom des classeurs dans la colonne A du classeur récap, et le nom de la ou des feuilles commençant par "Synt" dans la colonne B du classeur récap.

    J'ai essayé avec ce code, mais çà ne fonctionne pas. j'ai mis ici que pour le nom du classeur, mais j'ai besoin aussi du nom des feuilles.

    Je vous remercie par avance de votre aide.

    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
    Sub general()
        Application.ScreenUpdating = False
        
        'remplit les en-tete
        With ThisWorkbook.Sheets(1)
        .Cells(1, 1) = "Nom du classeur"
        .Cells(1, 2) = "Nom de la feuille"
        .Cells(1, 3) = "Client"
        .Cells(1, 4) = "Référence"
        .Cells(1, 5) = "Désignation"
        .Cells(1, 6) = "Forme Galénique"
        .Cells(1, 7) = "TDL"
        .Cells(1, 8) = "Prix de vente cible"
        .Cells(1, 9) = "Prix de vente client"
    
        End With
        
        'declaration de variable
        Dim objFSO As Object
        Dim objDossier As Object
        Dim objFichier As Object
        
        'initialisation des variables
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'definit le repertoire ou se trouvent les feuilles a traiter
        Set objDossier = objFSO.GetFolder("C:\Test\Fiches")
        
        'pour chaque classeur dans le répertoire
        For Each objFichier In objDossier.Files
            'ouvre le classeur
            Workbooks.Open objFichier
            
           Dim xlwksheet As Worksheet
     
      For Each xlwksheet In ActiveWorkbook.Sheets
        If xlwksheet.Name Like "Synt*" Then
          With xlwksheet
                
        
        'copie et colle le nom du classeur
            .objFichier.Name.Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("a65536").End(xlUp).Row + 1
            .Range("a" & DerLigne).PasteSpecial Paste:=xlPasteValues
    
            End With

  5. #5
    Expert confirmé Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    Décembre 2013
    Messages
    2 974
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : Décembre 2013
    Messages : 2 974
    Par défaut
    re

    qq chose comme :
    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
    For Each xlwksheet In ActiveWorkbook.Sheets
        If xlwksheet.Name Like "Synt*" Then
          With xlwksheet
     
        'copie et colle le client
            .Range("C2").Copy
            With ThisWorkbook.Sheets(1)
            DerLigne = .Range("a65536").End(xlUp).Row + 1
            .Range("a" & DerLigne).PasteSpecial Paste:=xlPasteValues
            if   .Range("d" & DerLigne)="" then .Range("d" & DerLigne)="manque prix"
     
            ' à ajouter nom d'onglet dans la colonne M comme exemple
             .Range("M" & DerLigne) = xlwksheet.Name
             .Range("N" & DerLigne) = Workbook.Name
     
     
            End With

  6. #6
    Membre confirmé
    Profil pro
    Inscrit en
    Avril 2004
    Messages
    154
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2004
    Messages : 154
    Par défaut
    Merci Bennasr

    Cela fonctionne bien pour le nom de la feuille, mais pas pour le nom du classeur.

    J'ai un message d'erreur qui indique "erreur d'exécution 424, objet requis.

    J'avoue que je ne comprends pas pourquoi ?

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

Discussions similaires

  1. Boucle avec une condition de temps
    Par mika745 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 20/09/2017, 16h36
  2. Boucle avec une condition if
    Par ion_ion dans le forum SAS Base
    Réponses: 2
    Dernier message: 18/12/2013, 16h53
  3. Créer une boucle avec une condition
    Par kaboche dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 04/10/2011, 09h55
  4. Réponses: 3
    Dernier message: 11/04/2008, 09h31

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