Groupe de travail en VBA

[Valérie]

Salut le forum,

Ha la la la la la la, je sais plus quoi lui dire il m'embete aujourd'hui XL.
Explication :
Mon classeur est composé de tout plein de feuilles dont les 2 dernières identiques en matière de titres de ligne.

J'ai besoin d'insérer une nouvelle ligne au même endroit dans les deux feuilles. Naïvement je pensais qu'en sélectionant les 2 feuilles à l'aide de l'instruction Array le tour serai joué!! Et bien non snif..

Je vous joins un exemple pour que vous compreniez un peu mieux ce que je vous dis.

@ bientôt et merci beaucoup de l'attention que vous apporterez à mon petit soucis

 

[Michel Spinnato]

Bonjour,

remplace ta première ligne de code afin de récupérer le nom des feuilles dans ton array :

ActiveWorkbook.Worksheets(Array(ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count - 1).Name, ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count).Name)).Select

 

[Valérie]

Salut Michel et merci

Mais à priori le pb ne vient pas de la sélection qui fonctionne à merceille avec mon code...

Yeu sait pas parceque réunion jusqu'à 18h empêche de travailler sur XL!!

@+
Valérie

 

[Ti]

Ben moi, j'ai rajouté une petite variable (!) et j'ai un peu modifié ton code, ça marche très bien ainsi

Sub Test()
Dim Ws
'Sélectionne l'avant dernère et la dernière feuille
For Each Ws In Array(Worksheets(Sheets.Count - 1), Worksheets(Sheets.Count))
With Ws
.Range("A10").EntireRow.Copy
.Range("A10").EntireRow.Insert xlDown
.Range("A11") = "NEW TEST"
End With
Next Ws
Application.CutCopyMode = False

End Sub

 

[@+Thierry]

Bonsoir Valérie, vite fait car je pars du bureau

Sub Test()
Dim WS As Worksheet
Dim TwoLastWS 'As Worksheet
'Sélectionne l'avant dernère et la dernière feuille
Set TwoLastWS = sheets(Array(sheets.Count - 1, sheets.Count))
' sheets(Array(sheets.Count - 1, sheets.Count)).Select


For Each WS In TwoLastWS
'Copy la ligne pour l'insérer
With WS
.Range("a10").EntireRow.Copy
'Insére la ligne copiée
.Range("A10").EntireRow.Insert xldowm
.Application.CutCopyMode = False
'C pour dire que ça change
.Range("A11") = "NEW TEST"
'Je sais ça n'a fonctionné que sur l'avant dernère C bine pour ça que je pieure!!
End With
Next WS
End Sub

Bon WOUUUUUUUIK END !!

@+Thierry (qui a presque plus mal aux dents ))

 

[@+Thierry]

Arf Ti, avait déjà répondu !!

Bonsoir Ti, ben oui (comme dab) tu es plus rapide et plus court !!! lol

Bon Week End à toi aussi

@+Thierry

 

[Ti]

Tiens, pour le même prix, je te mets une deuxième version :

Sub Test()
Dim Ws
Application.ScreenUpdating = False
For Each Ws In Array(Worksheets(Sheets.Count - 1), Worksheets(Sheets.Count))
With Ws.Range("A10")
.Offset(1, 0).EntireRow.Insert xlDown
.Copy .Offset(1, 0)
.Offset(1, 0) = "NEW TEST"
End With
Next Ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Ti

 

[Ti]

Salut Thierry, il faut dire que je n'ai pas trop forcé ces derniers temps, les souris n'ont qu'à bien se tenir

 

[Valérie]

Salut les VBAiens,

Ouais mais ça je l'avais déjà trouvé, y'a donc pas moyen à part une boucle de faire en macro ce que l'on sais faire en manuel!! JE DOUTE.

Mon pb C que si cela avait été aussi simple que ce code imaginez vous bien que je n'aurai pas hésité aux variables et à la boucle FOR EACH mais j'ai toute une procédure à réaliser sur ces 2 feuilles (avec des validations à placer sur certaines cellules, des couleurs, des bordures différentes en fonction de dates d'entrées saisies dans un USF etc...) et boucler me ralonge le temps de traitement de façon assez importante.

De toute façon Je continue dans ma quête du graal!! Excel et moi c une grande histoire dans laquelle je ne veux insérer que quelques variables!!!

Oila bon comme je vais beaucoup mieux maintenant que je vous ai exposé mon petit pb je vais me reposer pour être en forme et repartir du bon pied demain matin!!



@+ et bonne soirée
Valérie

 

[Ti]

Ah ben il fallait le dire que tu ne voulais pas boucler. Bon, le problème, c'est que sur une sélection de feuilles mutiple, tu ne peux travailler qu'avec les sélections, sinon ce brave XL renâcle, alors voilà une macro qui marche, sans aucune variable

Sub Test()
Sheets(Array(Sheets(Sheets.Count - 1).Name, Sheets(Sheets.Count).Name)).Select
Range("A11").Select
Selection.EntireRow.Insert xlDown
Range("A10").Copy
ActiveSheet.Paste
Range("A11").Select
Selection.Value = "NEW TEST"
Application.CutCopyMode = False
End Sub

Maintenant, je ne suis absolument pas sûr que ce soit plus rapide que les solutions précédentes et, personnellement, je préférerais ma boucle ci-dessus, à cette dernière solution : dès qu'il y a des sélections, il y a du temps perdu, sauf peut-être si tu dois faire ça sur 20 feuilles d'un coup...

 

[@+Thierry]

Bonjour ce fil et le forum

Quelle persévérance ce Ti !! Bravo.
Je pense que Valérie sera satisfaite, sans boucle.

Par contre je viens de faire un test avec toutes les méthodes, il n'y a pas vraiment de différence sur le temps d'exécution pour insérer une ligne, donc j'ai compliqué un peu les instructions sur deux feuilles... Et...... la boucle me semble un "chouilla" plus rapide... Mais ce n'est peut être qu'une impression...

Tiens à ce sujet, j'avais vu....... mais évidemment j'ai oubliè où ! un code qui permettait de retrourner le temps complet d'exécution d'une macro, est-ce que tu as ça en Stock Ti ?

Sur ce Bon Dimanche
@+Thierry

 

[Ti]

Salut Thierry, il m'arrive de tester le temps mis par différentes procédures en plaçant un compteur au début de la boucle et en regardant le temps écoulé à la fin, mais pour cela il faut une boucle significativement longue (plusieurs milliers de lignes à insérer par exemple), sinon on ne verra pas la différence.
Pour l'exemple de Valérie, il faudrait tester sur plusieurs dizaines de feuilles, et encore. Par contre, on pourrait utiliser une API GetTickCount, que j'ai utilisée dans le jeu d'allumettes d'André et qui renvoie une valeur plus précise que celles renvoyées par la fonction d'Excel (j'oublie sur l'instant laquelle c'est). Si ça peut t'intéresser, je peux faire un fichier d'exemple éventuellement

 

[@+Thierry]

Salut Ti,

ben je vais déjà faire un tour sur Lien supprimé et si j'ai besoin je te fais signe

Merci à toi
@+Thierry

 

[Ti]

Voilà un exemple de test de temps qui utilise GetTickCount. (GetTickCount renvoie le nombre de millisecondes écoulées depuis le lancement de Windows)

Option Explicit
Declare Function GetTickCount Lib "kernel32" () As Long

Sub TempsEcoule(Debut As Long)
Dim Temps As Long
Temps = GetTickCount - Debut
MsgBox Temps \ 1000 & " sec. et " & Temps - (Temps \ 1000) * 1000 & " centièmes"
End Sub


Sub test()
Dim boucle As Long, Debut As Long
Debut = GetTickCount
For boucle = 1 To 90000000
Next boucle
TempsEcoule Debut
End Sub

 

[@+Thierry]

Bonjour à Tout le monde

Super, je ne sais pas encore à quoi ça pourra me servir, mais c'est super. Merci Ti et bonne semaine à tous et toutes.

@+Thierry