Plusieur Sub VBA Résolu/Fermé

Question

Bonjour, 

J'ai ce code qui me pose problème : en effet il consiste à copier en bas de page, une liste de cellules remplies en ne tenant pas compte des espaces : une sorte de bilan en fin de feuille :

Sub copie()

Dim celOrg As Range
Dim celDst As Range

Set celDst = Columns("B").Find("*", , , , , xlPrevious)
If celDst Is Nothing Then Set celDst = Range("B1") Else Set celDst = celDst.Offset(1)

For Each celOrg In Worksheets("Feuil1").Range("S1:S208")
  
  If celOrg.Value > "" Then
  
    celDst.Value = celOrg.Value
       Set celDst = celDst.Offset(1)
  End If
Next celOrg
End Sub

mais voilà, j'ai bien le bilan en colonne B en fin de feuille, mais j'aimerais reproduire cette action 3 fois : plage"S1:S208, R1:R208 et T1:T208"

Comment exécuter ce code trois fois et le ranger comme suit :

avec ce code j'ai donc S1:S208 en colonne B

Je voudrais R1:R208 en colonne A

et T1:T208 en colonne G

Merci d'avance pour vos réponses

Configuration: Windows XP / Firefox 6.0

mikanadien2 · Answer

Salut... 

Tu peux expliquer exactement ce que  tu veux faire ?

Tu as une colonne B avec des valeurs... Et tu veux les recopier ailleurs si la cellule n est pas vide ? sur une range donnee ?

amaury08 · Answer

j'ai des données en :S1:S208, 
R1:R208 
et T1:T208

que je veut copier en bas de page en :

colonne A
Colonne B
et colonne G

tout en ne tenant pas compte des espaces en S R et T

une sorte de bilan quoi
un résumé de contrôle

mikanadien2 · Answer

Des espaces ou des cellulles vides ?

amaury08 · Answer

des cellules vides

mikanadien2 · Answer

Ok

mikanadien2 · Answer

Salut... Ceci devrait aller ___________________________________________________ R = 18 S = R+1 T =S +1 LinetoreportR = 210 LinetoreportS = 210 LinetoreportT = 210 For i = 1 to 208 If Cells(i, R) <>"" Then Valuetotake = Cells(i, R).text Cells(LinetoreportR, R).text = Valuetotake LinetoreportR = LinetoreportR +1 End If If Cells(i, S) <>"" Then Valuetotake = Cells(i, S).text Cells(LinetoreportS, S).text = Valuetotake LinetoreportS = LinetoreportS +1 End If If Cells(i, T) <>"" Then Valuetotake = Cells(i, T).text Cells(LinetoreportT, T).text = Valuetotake LinetoreportT = LinetoreportT +1 End If Next __________________________________________________ Tu as juste a change les valeurs de LinetoreportR LinetoreportS LinetoreportT Sur les lignes 5, 6 et 7 pour qu elles correspondent a l endroit ou tu veux commencer a ecrire ton bilan.... Esperant t avoir aide... Cordialement

amaury08 · Answer

rien ne se passe quand j'exécute ...

Peux tu me décrire à quoi servent les 6 premières lignes ?
à quoi correspond le R=18

mikanadien2 · Answer

R = 18, c est pour dire que c est la 18e colonne
S la 19e
T la 20e

les 3 lignes d apres, on definit l endroit ou on veut ecrire. A savoir le bilan de la colonne R , j ai mis ligne 210, pareil pour S et T.

T as quelque chose dans tes colonnes R S et T ?

amaury08 · Answer

non je n'ai rien dans les 3 colonnes ...

il est possible d'écrire le bilan en A266, B266 et G266 ?

évidemment dans l'ordre des colonnes R S et T

mikanadien2 · Answer

Ok... C est normal que le script ne fasse rien alors... Il zappe en fait toutes les cellules vides entre la ligne 1 a 208 dans les colonnes R S et T. Quand tu auras qq chose dans ces colonnes, (essaie des maintenant) le script marchera... Pour l ecriture du bilan il est tout a fait possible de l ecrire a partir des cellules que tu as enonce... Cela donne... A = 1 B = 2 C = 3 R = 18 S = R+1 T =S +1 LinetoreportR = 266 LinetoreportS = 266 LinetoreportT = 266 For i = 1 to 208 If Cells(i, R) <>"" Then Valuetotake = Cells(i, R).text Cells(LinetoreportR, A).text = Valuetotake LinetoreportR = LinetoreportR +1 End If If Cells(i, S) <>"" Then Valuetotake = Cells(i, S).text Cells(LinetoreportS, B).text = Valuetotake LinetoreportS = LinetoreportS +1 End If If Cells(i, T) <>"" Then Valuetotake = Cells(i, T).text Cells(LinetoreportT, C).text = Valuetotake LinetoreportT = LinetoreportT +1 End If Next __________________________________________________ Dis moi si ca te convient... ;)

amaury08 · Answer

j'ai pourtant un paquet de données dans les colonnes R S et T et rien ne se passe :

une question : il faut mettre un genre de sub avant ton code ?

mikanadien2 · Answer

Regarde... Enregistre une macro...appelle la "mafonction" Selectionne une cellule et arrete l enregistrement. Edite ta macro... Supprime la selection de la cellule et colle entre le sub et end sub ceci : A = 1 B = 2 C = 3 R = 18 S = R+1 T =S +1 LinetoreportR = 266 LinetoreportS = 266 LinetoreportT = 266 For i = 1 to 208 If Cells(i, R).text <>"" Then Valuetotake = Cells(i, R).text Cells(LinetoreportR, A).text = Valuetotake LinetoreportR = LinetoreportR +1 End If If Cells(i, S).text <>"" Then Valuetotake = Cells(i, S).text Cells(LinetoreportS, B).text = Valuetotake LinetoreportS = LinetoreportS +1 End If If Cells(i, T) <>.text"" Then Valuetotake = Cells(i, T).text Cells(LinetoreportT, C).text = Valuetotake LinetoreportT = LinetoreportT +1 End If Next Ensuite enregistre. Pour l exemple : Met une image dans ton fichier excel. Fais un click droit sur cette image. Affectes lui la macro que tu as cree... Et enfin, click sur l image... Au pire envoie moi ton fichier excel si vraiment tu y arrives pas

Patrice33740 · Answer

Re,

Essaie :
Sub copie()

Dim celOrg As Range
Dim celDst As Range

Set celDst = Columns("A").Find("*", , , , , xlPrevious)
If celDst Is Nothing Then Set celDst = Range("A1") Else Set celDst = celDst.Offset(1)
For Each celOrg In Worksheets("Feuil1").Range("R1:R208")
  If celOrg.Value > "" Then
    celDst.Value = celOrg.Value
    Set celDst = celDst.Offset(1)
  End If
Next celOrg

Set celDst = Columns("B").Find("*", , , , , xlPrevious)
If celDst Is Nothing Then Set celDst = Range("B1") Else Set celDst = celDst.Offset(1)
For Each celOrg In Worksheets("Feuil1").Range("S1:S208")
  If celOrg.Value > "" Then
    celDst.Value = celOrg.Value
    Set celDst = celDst.Offset(1)
  End If
Next celOrg

Set celDst = Columns("G").Find("*", , , , , xlPrevious)
If celDst Is Nothing Then Set celDst = Range("G1") Else Set celDst = celDst.Offset(1)
For Each celOrg In Worksheets("Feuil1").Range("T1:T208")
  If celOrg.Value > "" Then
    celDst.Value = celOrg.Value
    Set celDst = celDst.Offset(1)
  End If
Next celOrg

End Sub

amaury08 · Answer

malheureusement, quand j'exécute la macro, rien ne se passe
alors que le premier code que tu m'as donné marche du tonnerre

peut être parce qu'il était seul

amaury08 · Answer

voici le fichier en question ne tenez pas compte des blancs, j'ai effacé le contenu ce qui est imprtant c le haut et le bilan en bas :

https://www.cjoint.com/?AHylapZN4PG

mikanadien2 · Answer

Ca m intrigue... Y a moyen que tu m envoie le fichier excel par mail ou c est un fichier confidentiel ?

mikanadien2 · Answer

Par contre fait gaffe... Tu ne veux pas reporter en colonne A B et C, mais en colonne A B et G...
Cordialement

Patrice33740 · Answer

Re,

Ce dernier code en #25 est différent de tes objectifs initiaux et du code en  #14
Lors d'une nouvelle exécution :
- Il n'ajoute pas les renseignements au précédents mais il les écrase.
- Il reste un défaut : il n'efface pas les renseignement précédents, il risque donc d'en rester si il y en a moins que la fois précédente.

Plusieur Sub VBA

18 réponses

Discussions similaires