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.