VBA- Synthese de calcul

Version imprimable

05/08/2011, 14h36
leBlindé

VBA- Synthese de calcul

Bonjour à tous! j'ai besoin d'aide assez rapidement concernant la programmation d'une synthese entre un certain nombre de feuille et selon le type de feuille copier des valeurs dans des colonnes!

Pour être plus clair j'explik et je joinds le fichier excel
mon déroulement de programme est:

(le nombre de feuille étant déja créé)
-dans la 1ère feuille je veux copier les données cell B1 vers feuille "Results" en D3
-si la cell C5 de la 1ère feuille = au text "privative" alors la cell O45 de cette feuille sera copié feuille "Results" dans colonne E dans la dernière ligne vide. et les dernières lignes des colonnes F et G seront vidées.

-si la cell C5 de la 1ère feuille = au text "comptabilisée" alors la cell O45 de cette feuille sera copié feuille "Results" dans colonne F dans la dernière ligne vide. et les dernières lignes des colonnes E et G seront vidées.

-si la cell C5 de la 1ère feuille = au text "Annexe" alors la cell O45 de cette feuille sera copié feuille "Results" dans colonne G dans la dernière ligne vide. et les dernières lignes des colonnes E et F seront vidées.

-passer à la ligne suivante dans feuille "results" et feuille suivante dans la liste des feuilles créées.

si B1 de cette feuille suivante = B1 de la feuille précédente alors on enregistre les données sur la ligne précendente de la feuille "results"

le fichier peut etre récupéré à cette adresse trop lourd pour etre posté ici:
http://www.developpez.net/forums/d84...s-discussions/

j'espère que l'on pourra m'aider merci par avance
05/08/2011, 14h42
SfJ5Rpw8

et ou en est tu de ton code ? par quoi est tu bloqué ? ..

j'ai seulement reussi a copier B1 en B3 avec ce code

Code:

1
2
3
4
5
6
7
8
9
Sub Extraire()
 
Sheets("Results").Range("D3:D200").ClearContents
Derligne = Sheets("Results").Range("D3").End(xlUp).Row + 1
 
   For i = 6 To Worksheets.Count
 Range("D" & Derligne).Value = Sheets(i).Range("B1").Value
 Derligne = Derligne + 1
   Next i

Citation:
Envoyé par leBlindé
j'ai seulement reussi a copier B1 en B3 avec ce code
Code:

1 2 3 4 5 6 7 8 9 Sub Extraire() Sheets("Results").Range("D3:D200").ClearContents Derligne = Sheets("Results").Range("D3").End(xlUp).Row + 1 For i = 6 To Worksheets.Count Range("D" & Derligne).Value = Sheets(i).Range("B1").Value Derligne = Derligne + 1 Next i
Pourquoi effectuer une boucle ( For ..i..) si tu ne doit copier la donné d'une seule feuille ?
et si c'est pour copier en D3 ... pourquoi calculer le numéro de la dernière ligne ?
Code:

1 2 Sheets("Results").Range("D3:D200").ClearContents Sheets("Results").Range("D3") = sheets(1).Range("B1") ' on peu changer sheets(1) par sheets("Mafeuille")

05/08/2011, 23h10
leBlindé

En fait j'ai une macro qui me permet de rentrer des données de mesurages et à chaque local mesuré je créé une nouvelle feuille.
Pour chaque immeuble le nombre de local est différent donc le nombre de feuille de données sera différent à chaque fois.

donc le but est de copier tous les noms des locaux situés en B1 de chaque feuille en D3 puis D4... de la feuille de synthèse.
donc j'ai utilisé derligne

c'est après que je bloque la partie difficile C5 je maîtrise pas assez les codes VBA pour touver le bon chemin

En tout cas merci pour l'aide c'est super !

Bonjour à tous,

Citation:

le fichier peut etre récupéré à cette adresse trop lourd pour etre posté ici : http://www.developpez.net/forums/d84...s-discussions/

Le fichier n'y est plus, normal si tu le mets en tout début de discussion

Citation:

si la cell C5 de la 1ère feuille = au text "privative" alors la cell O45 de cette feuille sera copié feuille "Results" dans colonne E dans la dernière ligne vide. et les dernières lignes des colonnes F et G seront vidées.

Dans a boucle
Code:

1 2 3 4 5 6 7 8 9 10 11 12 IF Sheets("Nom 1ère feuille").Range("C5") = "privative" then With Sheets("Results") ' Récupérer la dernière ligne vide de la colonne E DLigR = .Range("E" & Rows.Count).End(XlUp).Row + 1 .Range("E" & DligR) = Sheets("Nom 1ère feuille").Range("O45") ' Effacer les 3 dernières lignes de la colonne F et G DLigR = .Range("F" & Rows.Count).End(XlUp).Row .Range("F" & DLigR -2 & ":F" & DLigR).ClearContents DLigR = .Range("G" & Rows.Count).End(XlUp).Row .Range("G" & DLigR -2 & ":G" & DLigR).ClearContents End With End If
Essaye d'analyser et de comprendre ce code, teste le, et dis nous ;)

A+

06/08/2011, 09h25
leBlindé

J'essaye d'appliquer ton code bruno je crois que c'est cette prtie que je comprends pas trop
Que signifie les deux points avant le F ---->":F"

Code:

.Range("F" & DLigR -2 & ":F" & DLigR).ClearContents

Merci encore d'avoir de l'aide de génie !;)
06/08/2011, 09h35
SfJ5Rpw8

le code : "F" & DLigR -2 & ":F" & DLigR permet
grâce à une concaténation de chaine de définir l'adresse de la plage à tester ... avec DligR = 5 .. l'adresse calculée devient :

"F3:F5";)
06/08/2011, 09h55
Invité

Citation:

Envoyé par bbil

le code : "F" & DLigR -2 & ":F" & DLigR permet grâce à une concaténation de chaine de définir l'adresse de la plage à tester ... avec DligR = 5 .. l'adresse calculée devient :
"F3:F5"

Merci Mister bbil ;) :ccool:
06/08/2011, 10h02
leBlindé

d'accord, oui je viens de comprendre.
une autre question, y a-t-il une méthode pour faire :

si la feuille contient le nom "SP" alors...
06/08/2011, 10h15
Invité

Re,

Code:

If InStr(1, Sht.Name, "SP", vbTextCompare) > 0 Then

A+
06/08/2011, 10h15
SfJ5Rpw8

leBlindé peu-tu traduire l'expression en rouge ?

[Edit] : Peu-être que bruno à compris ta demande mais pas moi ...

c'est bon ça prends tournure je suis sur la bonne piste :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub Extraire() Sheets("Results").Range("D3:D200").ClearContents Derligne = Sheets("Results").Range("D3").End(xlUp).Row + 1 For i = 6 To Worksheets.Count - 1 Range("D" & Derligne).Value = Sheets(i).Range("B1").Value If Sheets(i).Name <> "SP" Then With Sheets("Results") ' Récupérer la dernière ligne vide de la colonne E DLigR = .Range("E" & Rows.Count).End(xlUp).Row + 1 .Range("E" & DLigR) = Sheets(i).Range("O46") End With End If Derligne = Derligne + 1 Next i End Sub
j'ai fais commencer ma boucle à la feuille 6 (debut de ma serie de feuille)
coller l'info B1 en colonne D -> ok
si la feuille contient SP alors copier coller la cell O46 de la feuille i en derniere ligne de la colonne E.
on passe a une autre feuille i

me reste à inserer d'autre condition similaire.
Je devrais le faire fonctionner !

Merci pour votre aide, vous êtes super les gars, si c'est réglé je clique sur RESOLU. je tiens au courant

06/08/2011, 10h45
SfJ5Rpw8

Ce que je voudrais comprendre c'est : "si la feuille contient SP " ? cela veut dire quoi ? ou tu doit trouver SP ? c'est quoi SP ? du texte ??...
06/08/2011, 11h08
leBlindé

oui c'est du texte "SP"

en fait j'ai 3 feuille de base "SP" "SNC" et "ANN"
au départ en fonction de situation je rentre des données et je vais avoir un certain nombre de feuille de chaque catégorie "SP" "SNC" et "ANN"
donc la première feuille SP sera nommée "SP" la seconde "SP(2) et etc...

Dans ma formule je souhaite que pour si le nom de la feuille contient SP qu'il envoie en feuille Result la cellule O45 en dernière ligne de colone E et qu'il marque rien ou 0 sur la même ligne en colonne F et G

si le nom de la feuille contient SNC qu'il envoie en feuille Result la cellule O45 en dernière ligne de colone F et qu'il marque rien ou 0 sur la même ligne en colonne E et G

si le nom de la feuille contient ANN qu'il envoie en feuille Result la cellule O45 en dernière ligne de colone G et qu'il marque rien ou 0 sur la même ligne en colonne E et F
06/08/2011, 11h17
SfJ5Rpw8

ah ok ... ben il te reste plus qu'as adapter le code à Bruno plus haut ...
06/08/2011, 11h25
Invité

Tu as vu bbil ... j'avais sorti ma boule de cristal ;):lol:
09/08/2011, 11h33
leBlindé

j'ai essayé de bidouiller la formule pour que :

si le nom de ma feuille contient "SP" alors ...
j'ai fais

Code:

If InStr(1, Sht.Name, "SP", vbTextCompare) > 0 Then

mais j'ai un message erreur d'execution 424 Objet requis
ca veut dire qu'il manque quelque chose et je sais pas quoi!

merci pour votre soutien

le seul objet visible c'est sht ... il faut le définir .. par exemple :
Code:

1 2 3 4 dim sht as worksheet For each sht in ThisWorkbook.workSheets (...) 'Place ton test ici ... next

j'ai déja des paramètre en jeu si je rajoute un dimensionnement ça va me bloque:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 'je commence par instaurer mon champs d'action de la feuille 6 à l'avant dernière
For i = 6 To Worksheets.Count - 1
'je veux que la cellule B1 de chaque feuille se remplissent à la suite en colone D
 Range("D" & Derligne).Value = Sheets(i).Range("B1").Value
'LA JE GALERE A DIRE: Si le nom de la feuille contient "SP" alors transfert de donnée de la cellule O46 en feuille results dans colonne E ... j'ai essayé votre formule à caler ca bloque
 If Sheets(i).Name <> "SP" Then
  With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne E
    DLigR = .Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("E" & DLigR) = Sheets(i).Range("O46")
    End With
     Else
    With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne E
    DLigR = .Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("E" & DLigR) = "-"
    End With
End If

09/08/2011, 12h05
Invité

Bonjour
Salut Bbil ;)

Citation:

Envoyé par leBlindé

j'ai essayé de bidouiller la formule pour que :
si le nom de ma feuille contient "SP" alors ...
j'ai fais

Code:

If InStr(1, Sht.Name, "SP", vbTextCompare) > 0 Then

Dis LeBlindé t'es pas un peu gonflé :furax:

Ce n'est pas ce que je t'ai mais sur le 10ème post au dessus, ici
http://www.developpez.net/forums/d11...l/#post6167661

T'as fait ... la prochaine fois ce sera sans moi :roll:
Non mais ...
09/08/2011, 12h16
SfJ5Rpw8

oui je crois qu'un peu d'effort pour comprendre le code que tu présente ne ferais pas de mal ...
à quoi sert ce code : If Sheets(i).Name <> "SP" Thenpour toi ?

et pour l'utilisation de la fonction InStr présenté par Bruno la touche :f1: devrait te retourner l'aide souhaité ...
09/08/2011, 12h47
leBlindé

Quand j'ai dis bidouillé j'ai essayé ta formule Bruno que je n'arrivais pas à faire marcher donc j'ai essayé de comprendre pourquoi sans arriver à le faire marcher.
je me suis mal exprimé "j'ai fais", je veux dire j'ai executé le code de bruno.

pour moi :

Code:

If Sheets(i).Name <> "SP" Then

signifie si le nom de la feuille contient "SP" alors mais je crois que cela veut dire si le nom de la feuille est "SP" alors.
09/08/2011, 12h50
SfJ5Rpw8

en vb <> ce lit "différent" ...

Citation:

Envoyé par bbil

et pour l'utilisation de la fonction InStr présenté par Bruno la touche :f1: devrait te retourner l'aide souhaité ...
09/08/2011, 13h26
leBlindé

ah dsl, j'étais pensais que <> signifiait contenient.
Merci pour l'info, je vais me réferer à l'aide de vb lors comme vous dites pour essayer de régler tout ça

Merci en tout cas pour les coups de pouce.:ccool:

Le problème est résolu grâce à la grande aide de bruno et Bbil
Merci beaucoup :ccool: vous êtes super les gars

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
Sub Extraire()
 
'feuille resultats de la colonne D3 a D200 NETTOYAGE
Sheets("Results").Range("D3:D200").ClearContents
'l'item derligne commencera feuille resultats en colonne D3 avec décalage rangée +1 si remplie
Derligne = Sheets("Results").Range("D3").End(xlUp).Row + 1
 
'boucle pour toute les feuilles,la valeur colonne D derniere ligne = sur cette 1ere feuille la valeur de la cellule B1
'passage a la cellule suivante comme dernière ligne
'prochaine feuille
 
Dim I As Integer
   For I = 6 To Worksheets.Count - 1
 If InStr(1, Sheets(I).Name, "SP", vbTextCompare) > 0 Then
 Range("D" & Derligne).Value = Sheets(I).Range("B1").Value
  With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne E
    DLigR = .Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("E" & DLigR) = Worksheets(I).Range("O46").Value
    End With
       Else
    Range("D" & Derligne).Value = Sheets(I).Range("B1").Value
    With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne E
    DLigR = .Range("E" & Rows.Count).End(xlUp).Row + 1
    .Range("E" & DLigR) = "-"
    End With
End If
If InStr(1, Sheets(I).Name, "SNC", vbTextCompare) > 0 Then
 Range("D" & Derligne).Value = Sheets(I).Range("B1").Value
  With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne F
    DLigR = .Range("F" & Rows.Count).End(xlUp).Row + 1
    .Range("F" & DLigR) = Worksheets(I).Range("O46")
    End With
     Else
    With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne F
    DLigR = .Range("f" & Rows.Count).End(xlUp).Row + 1
    .Range("f" & DLigR) = "-"
    End With
End If
If InStr(1, Sheets(I).Name, "ANN", vbTextCompare) > 0 Then
 Range("D" & Derligne).Value = Sheets(I).Range("B1").Value
  With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne G
    DLigR = .Range("G" & Rows.Count).End(xlUp).Row + 1
    .Range("G" & DLigR) = Worksheets(I).Range("O46")
    End With
     Else
    With Sheets("Results")
    ' Récupérer la dernière ligne vide de la colonne G
    DLigR = .Range("g" & Rows.Count).End(xlUp).Row + 1
    .Range("g" & DLigR) = "-"
    End With
End If
 Derligne = Derligne + 1
   Next I
 End Sub