Boucle avec une condition

Version imprimable

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:

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:

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.

bonjour
et si après le copiage du prix tu vérifie si la valeur est vide à ce moment tu écris "manque prix"

Code:

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

07/10/2020, 10h01
aweb

Merci beaucoup Bennasr, cela fonctionne.

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

Merci encore !

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:

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

re

qq chose comme :

Code:

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

07/10/2020, 15h26
aweb

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 ?
07/10/2020, 17h18
BENNASR

tester :

Code:

.Range("N" & DerLigne) =ThisWorkbook.Name
07/10/2020, 17h23
aweb

Alors, le code fonctionne avec ThisWorkbook.Name

Par contre, ce n'est pas le bon nom de classeur que je souhaite.
Avec Thisworbook, il reprend le nom du classeur qui contient mon code, or c'est le nom du classeur d'origine que je souhaite récupérer, celui que j'ouvre puis sur lequel je prend les infos que je copie dans le tableau récap, et que je referme ensuite pour passer au suivant.
07/10/2020, 17h27
aweb

J'ai trouvé

il fallait mettre

Code:

.Range("N" & Derligne) = objFichier.Name
07/10/2020, 17h28
aweb

Merci beaucoup Bennasr