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"
Je vous remercie d'avance pour 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
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
Partager