Reduire ma macro

Le
frayer
Bjr, Cette macro copie et transfere chaque fois une ligne
de donnees dans un file, elles sont toutes differentes les
unes des autres. Et mon file s'arrete a 30 lignes.
Suis sur qu'un crack peut mettre cette macro en 4 ou 5
lignes. Voila le bebe et mci pour l'aide
____
Sub Recap_Access()
'
' Recap_Access Macro
' Macro recorded 07.04.99 by MSCGVA
'
' TRAITEMENT DES D/AS ELECTRONIQUES
' PHASE 2 :

'Button macro "T_RECAPAccess"
'-
'Copie et transfert de la ligne de donnes des
worksheet "RECAPACCESS"
'des diffrents DA dans file "01_TESTACCESS1.xls"

Range("A2:IC2").Select
Selection.Copy
'--
Windows("01_TESTACCESS1.xls").Activate
If Range("A2") = Empty Then
Range("A2").Select
ElseIf Range("A3") = Empty Then
Range("A3").Select
ElseIf Range("A4") = Empty Then
Range("A4").Select
ElseIf Range("A5") = Empty Then
Range("A5").Select
ElseIf Range("A6") = Empty Then
Range("A6").Select
ElseIf Range("A7") = Empty Then
Range("A7").Select
ElseIf Range("A8") = Empty Then
Range("A8").Select
ElseIf Range("A9") = Empty Then
Range("A9").Select
ElseIf Range("A10") = Empty Then
Range("A10").Select
ElseIf Range("A11") = Empty Then
Range("A11").Select
ElseIf Range("A12") = Empty Then
Range("A12").Select
ElseIf Range("A13") = Empty Then
Range("A13").Select
ElseIf Range("A14") = Empty Then
Range("A14").Select
ElseIf Range("A15") = Empty Then
Range("A15").Select
ElseIf Range("A16") = Empty Then
Range("A16").Select
ElseIf Range("A17") = Empty Then
Range("A17").Select
ElseIf Range("A18") = Empty Then
Range("A18").Select
ElseIf Range("A19") = Empty Then
Range("A19").Select
ElseIf Range("A20") = Empty Then
Range("A20").Select
ElseIf Range("A21") = Empty Then
Range("A21").Select
ElseIf Range("A22") = Empty Then
Range("A22").Select
ElseIf Range("A23") = Empty Then
Range("A23").Select
ElseIf Range("A24") = Empty Then
Range("A24").Select
ElseIf Range("A25") = Empty Then
Range("A25").Select
ElseIf Range("A26") = Empty Then
Range("A26").Select
ElseIf Range("A27") = Empty Then
Range("A27").Select
ElseIf Range("A28") = Empty Then
Range("A28").Select
ElseIf Range("A29") = Empty Then
Range("A29").Select
ElseIf Range("A30") = Empty Then
Range("A30").Select
ElseIf Range("A31") = Empty Then
Range("A31").Select
Else
Range("A2").Select
End If
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Elicend_News
Le #1390825
salut

le select case ne conviendrait il pas?
sinon moi j'aime pas trop range qd je ne cherche que dans une cellule,
j'utilise plutot cell(ligne, colonne).value, ou .select....

dans ton cas tu pourrais aussi faire une boucle qui incremente de ligne en
ligne et qui teste la valeur de la ligne, un peu sur ce schéma

dim var01
var01=1
do while(var01<100)
if cell(1,var01) ---->ton test then cell(1,Var01).select
var=var+1
loop

attention j'ai pas essayé mais juste rédigé ca comme ca de memoire par
rapport à ce que je fait habituellement ;)

elicend

"frayer" a écrit dans le message de
news:9d8501c4343c$2af57cf0$
Bjr, Cette macro copie et transfere chaque fois une ligne
de donnees dans un file, elles sont toutes differentes les
unes des autres. Et mon file s'arrete a 30 lignes.
Suis sur qu'un crack peut mettre cette macro en 4 ou 5
lignes. Voila le bebe et mci pour l'aide
____
Sub Recap_Access()
'
' Recap_Access Macro
' Macro recorded 07.04.99 by MSCGVA
'
' TRAITEMENT DES D/AS ELECTRONIQUES
' PHASE 2 :

'Button macro "T_RECAPAccess"
'-------------------------------------------------------
'Copie et transfert de la ligne de données des
worksheet "RECAPACCESS"
'des différents DA dans file "01_TESTACCESS1.xls"

Range("A2:IC2").Select
Selection.Copy
'-----------
Windows("01_TESTACCESS1.xls").Activate
If Range("A2") = Empty Then
Range("A2").Select
ElseIf Range("A3") = Empty Then
Range("A3").Select
ElseIf Range("A4") = Empty Then
Range("A4").Select
ElseIf Range("A5") = Empty Then
Range("A5").Select
ElseIf Range("A6") = Empty Then
Range("A6").Select
ElseIf Range("A7") = Empty Then
Range("A7").Select
ElseIf Range("A8") = Empty Then
Range("A8").Select
ElseIf Range("A9") = Empty Then
Range("A9").Select
ElseIf Range("A10") = Empty Then
Range("A10").Select
ElseIf Range("A11") = Empty Then
Range("A11").Select
ElseIf Range("A12") = Empty Then
Range("A12").Select
ElseIf Range("A13") = Empty Then
Range("A13").Select
ElseIf Range("A14") = Empty Then
Range("A14").Select
ElseIf Range("A15") = Empty Then
Range("A15").Select
ElseIf Range("A16") = Empty Then
Range("A16").Select
ElseIf Range("A17") = Empty Then
Range("A17").Select
ElseIf Range("A18") = Empty Then
Range("A18").Select
ElseIf Range("A19") = Empty Then
Range("A19").Select
ElseIf Range("A20") = Empty Then
Range("A20").Select
ElseIf Range("A21") = Empty Then
Range("A21").Select
ElseIf Range("A22") = Empty Then
Range("A22").Select
ElseIf Range("A23") = Empty Then
Range("A23").Select
ElseIf Range("A24") = Empty Then
Range("A24").Select
ElseIf Range("A25") = Empty Then
Range("A25").Select
ElseIf Range("A26") = Empty Then
Range("A26").Select
ElseIf Range("A27") = Empty Then
Range("A27").Select
ElseIf Range("A28") = Empty Then
Range("A28").Select
ElseIf Range("A29") = Empty Then
Range("A29").Select
ElseIf Range("A30") = Empty Then
Range("A30").Select
ElseIf Range("A31") = Empty Then
Range("A31").Select
Else
Range("A2").Select
End If
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
End Sub
isabelle
Le #1390326
bonjour frayer,

j'y ai ajouter la selection de la feuille, il faudra adapter à son nom.

Sub Recap_Access()
Set dest = Workbooks("01_TESTACCESS1.xls").Sheets("??").Range("A" & _
Range("A65536").End(xlUp).Row + 1)
Range("A2:IC2").Copy
Windows("01_TESTACCESS1.xls").Activate
Sheets("??").Activate
dest.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: _
False, Transpose:úlse
End Sub

isabelle


Bjr, Cette macro copie et transfere chaque fois une ligne
de donnees dans un file, elles sont toutes differentes les
unes des autres. Et mon file s'arrete a 30 lignes.
Suis sur qu'un crack peut mettre cette macro en 4 ou 5
lignes. Voila le bebe et mci pour l'aide
____
Sub Recap_Access()
'
' Recap_Access Macro
' Macro recorded 07.04.99 by MSCGVA
'
' TRAITEMENT DES D/AS ELECTRONIQUES
' PHASE 2 :

'Button macro "T_RECAPAccess"
'-------------------------------------------------------
'Copie et transfert de la ligne de données des
worksheet "RECAPACCESS"
'des différents DA dans file "01_TESTACCESS1.xls"

Range("A2:IC2").Select
Selection.Copy
'-----------
Windows("01_TESTACCESS1.xls").Activate
If Range("A2") = Empty Then
Range("A2").Select
ElseIf Range("A3") = Empty Then
Range("A3").Select
ElseIf Range("A4") = Empty Then
Range("A4").Select
ElseIf Range("A5") = Empty Then
Range("A5").Select
ElseIf Range("A6") = Empty Then
Range("A6").Select
ElseIf Range("A7") = Empty Then
Range("A7").Select
ElseIf Range("A8") = Empty Then
Range("A8").Select
ElseIf Range("A9") = Empty Then
Range("A9").Select
ElseIf Range("A10") = Empty Then
Range("A10").Select
ElseIf Range("A11") = Empty Then
Range("A11").Select
ElseIf Range("A12") = Empty Then
Range("A12").Select
ElseIf Range("A13") = Empty Then
Range("A13").Select
ElseIf Range("A14") = Empty Then
Range("A14").Select
ElseIf Range("A15") = Empty Then
Range("A15").Select
ElseIf Range("A16") = Empty Then
Range("A16").Select
ElseIf Range("A17") = Empty Then
Range("A17").Select
ElseIf Range("A18") = Empty Then
Range("A18").Select
ElseIf Range("A19") = Empty Then
Range("A19").Select
ElseIf Range("A20") = Empty Then
Range("A20").Select
ElseIf Range("A21") = Empty Then
Range("A21").Select
ElseIf Range("A22") = Empty Then
Range("A22").Select
ElseIf Range("A23") = Empty Then
Range("A23").Select
ElseIf Range("A24") = Empty Then
Range("A24").Select
ElseIf Range("A25") = Empty Then
Range("A25").Select
ElseIf Range("A26") = Empty Then
Range("A26").Select
ElseIf Range("A27") = Empty Then
Range("A27").Select
ElseIf Range("A28") = Empty Then
Range("A28").Select
ElseIf Range("A29") = Empty Then
Range("A29").Select
ElseIf Range("A30") = Empty Then
Range("A30").Select
ElseIf Range("A31") = Empty Then
Range("A31").Select
Else
Range("A2").Select
End If
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
End Sub


Publicité
Poster une réponse
Anonyme