rajout code VBA

[jc de lorient]

Bonjour le forum

pour bien finir mon projet je souhaiterais "marier" 2 codes VBA

ils fontionnent très bien quand je les utilise seul mais je n'arrive pas a les mélanger

voiçi mon 1er code :

Sub MultiCellCopy()
Dim DataSource(69) As Variant
Dim LastLine As Long
Dim Item As Variant
Dim i As Byte, y As Byte

LastLine = Sheets("Récap").Range("A65536").End(xlUp).Row + 1


For Each Item In Array("i9", "e22", "f22", "e24", "e25", "c16", "g34", "f79", "f35", "f37", _
"f39", "f47", "f49", "f53", "f55", "f57", "f59", "f61", "j35", "j37", _
"j39", "j41", "j43", "j45", "j47", "j49", "j51", "j53", "j55", "j57", _
"j59", "k63", "i65", "k65", "g69", "f71", "f73", "e75", "f75", "g77", _
"i65", "i66", "i67", "i68", "k66", "k67", "k68", "e80", "f80", "i80", "k80", _
"e23", "b28", "g28", "b29", "g29", "b30", "g30", "b31", "g31", "b32", "g32", _
"c17", "c15", "C13", "c10", "i12", "E61", "i15")

DataSource(i) = Sheets("fiche_paye").Range(Item)
i = i + 1
Next

For y = 1 To 69
With Sheets("Récap")
.Cells(LastLine, y) = DataSource(y - 1)
End With
Next

End Sub

je voudrais qu'après ce 1er code celui çi s'effectue :


Range("I9,i12,E22:E25,B28:b32,C17,G28:G32").Select
Range("G28").Activate
ActiveWindow.SmallScroll Down:=45
Range("I9,i12,E22:E25,B28:b32,C17,G28:G32,E75").Select
Range("E75").Activate
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-93
Range("I9").Select

merci a vous tous et très bon début de semaine

JC

 

[léa]

Bonjour JC,

Soit qu'en fin de la première routine tu l'appelles
Call deuxième_code
soit tu le places entre la dernière ligne " du premier "Next et le "End Sub"
Léa

 

[jc de lorient]

Merci Léa et quelle rapidité !!!!

j'ai fait comme tu m'as dit mais ma 2ème routine plante encore

voilà ce que j'ai fait

For y = 1 To 69
With Sheets("Récap")
.Cells(LastLine, y) = DataSource(y - 1)
End With
Next

Call Effacer

End Sub

A priori c la 1ère ligne "Range" qui plante ! Si y'a erreur ou se trouve t elle ?

merci bcp

JC

 

[léa]

Envoie moi ton bout de fichier, ce sera plus simple
Léa

 

[jc de lorient]

re le forum, Léa

ci joint mon fichier (juste limite en taille)

sur l'onglet Fiche_paye pouvoir rajouter sue le commandbutton enregistrer(module8) le module2 Effacer tout en gardeant le bouton effacer sur cette feuille

espérant etre suffisamment clair

Merci bcp

JC

 

[léa]

ReBonjour JC,

Je ne comprends pas, j'ai réalisé ce que je te préconnisais et ça marche, si ce n'est que par souci d'exthétique j'ai rajouté la commande "Call Effacer" non pas dans le module 8 mais dans le code du bouton "Enregistrer"
Ce code est devenu :

Private Sub CommandButton3_Click()
MultiCellCopy
Application.ScreenUpdating = False
Effacer
Application.ScreenUpdating = True
End Sub

Application.ScreenUpdating = False (ou True) permet d'éviter les scintillements affreux lors du déplacement de la fenêtre (je ne sais pas si tu connais)

A ta disposition
Léa

PS : le fichier corrigé ne veut pas passer, si tu lre désires donne moi ton e-mail

 

[jc de lorient]

merci bcp Léa

ci dessus mon mail. je ne comprends vraiment pas si chez toi ça marche et pas içi !!!! Ah les grands mystères de l'informatique !!!

je vé tester ton fichier en espérant que ça ira

mille merci et bonne journée

JC

 

[ChTi'160]

Salut"jc de Loriant"
bonjour léa
chez moi cà ne fonctionne pas
j'ai utilisé
with Worksheets(
set maplage=Union(.Range("I9"),etc ,etc,Range("C22:C34"),etc)
maplage .select
Selection.clearcontents
en ajoutant comme le dit Léa la procèdure au bouton enregistrer
car la procèdure telle qu'elle était butte sur la sélection des Plages
enfin à voir
A+++
Jean Marie

 

[jc de lorient]

salut ChTi

j'ai essayé d'adapter ton code mais je dois planter quelquepart

Aurais tu la grande bonté d'adapter ton idée à mon code ? et de me le mettre en copie içi ?

Merci d'avance !!
JC

 

[ChTi'160]

re "jc"
j'ai cru comprendre que tu voulais effacer les cellules après achivage
donc j'ai adapté ta macro car chez moi j'ai un problème de range
et de cellules fusionnées
cette macro je l'ai collé dans la procèdure click du bouton "Enregister les données" et là ca marche
(b]Sub Effacer()[/b]
'
' Effacer Macro
Application.ScreenUpdating = False
Set maplage = Union(Range("I9"), Range("i12"), Range("E22:E25"), Range("B28:b32"), Range("C17"), Range("G28:G32"), Range("E75"))
maplage.Select
Selection.ClearContents
Range("I9").Select
Application.ScreenUpdating = True
End Sub
tu recopies celà à la place de ta macro que tu peux quand même sauvegarder
tiens nous au courant
A+++
Ps les Routiers sont Sympa Lol
Jean Marie

 

[ChTi'160]

re
pour le bouton celà donne
Private Sub CommandButton3_Click()
MultiCellCopy
Effacer
End Sub
A+++
Jean Marie

 

[jc de lorient]

Re le forum, Léa, Jean Marie

je ne dirai qu'une chose : DE LA BALLE !!!!!!!!!!!!!!!!!!!!!!!!!

merci infiniement a vous tous et toutes

avec ça mon projet est complétement terminé

merci encore et bonne journée a vous

JC

 

[ChTi'160]

Eh bien BRAVO !!!!!!!!!!!!!!!!!!!!!
au prochain projet
A+++
Jean Marie