Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Reduire ma macro

Reduire ma macro

2 réponses
Avatar
frayer
Bjr, Cette macro copie et transfere chaque fois une ligne=20
de donnees dans un file, elles sont toutes differentes les=20
unes des autres. Et mon file s'arrete a 30 lignes.
Suis sur qu'un crack peut mettre cette macro en 4 ou 5=20
lignes. Voila le bebe et mci pour l'aide
____=20
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=E9es des=20
worksheet "RECAPACCESS"
'des diff=E9rents DA dans file "01_TESTACCESS1.xls"

Range("A2:IC2").Select
Selection.Copy
'-----------
Windows("01_TESTACCESS1.xls").Activate
If Range("A2") =3D Empty Then
Range("A2").Select
ElseIf Range("A3") =3D Empty Then
Range("A3").Select
ElseIf Range("A4") =3D Empty Then
Range("A4").Select
ElseIf Range("A5") =3D Empty Then
Range("A5").Select
ElseIf Range("A6") =3D Empty Then
Range("A6").Select
ElseIf Range("A7") =3D Empty Then
Range("A7").Select
ElseIf Range("A8") =3D Empty Then
Range("A8").Select
ElseIf Range("A9") =3D Empty Then
Range("A9").Select
ElseIf Range("A10") =3D Empty Then
Range("A10").Select
ElseIf Range("A11") =3D Empty Then
Range("A11").Select
ElseIf Range("A12") =3D Empty Then
Range("A12").Select
ElseIf Range("A13") =3D Empty Then
Range("A13").Select
ElseIf Range("A14") =3D Empty Then
Range("A14").Select
ElseIf Range("A15") =3D Empty Then
Range("A15").Select
ElseIf Range("A16") =3D Empty Then
Range("A16").Select
ElseIf Range("A17") =3D Empty Then
Range("A17").Select
ElseIf Range("A18") =3D Empty Then
Range("A18").Select
ElseIf Range("A19") =3D Empty Then
Range("A19").Select
ElseIf Range("A20") =3D Empty Then
Range("A20").Select
ElseIf Range("A21") =3D Empty Then
Range("A21").Select
ElseIf Range("A22") =3D Empty Then
Range("A22").Select
ElseIf Range("A23") =3D Empty Then
Range("A23").Select
ElseIf Range("A24") =3D Empty Then
Range("A24").Select
ElseIf Range("A25") =3D Empty Then
Range("A25").Select
ElseIf Range("A26") =3D Empty Then
Range("A26").Select
ElseIf Range("A27") =3D Empty Then
Range("A27").Select
ElseIf Range("A28") =3D Empty Then
Range("A28").Select
ElseIf Range("A29") =3D Empty Then
Range("A29").Select
ElseIf Range("A30") =3D Empty Then
Range("A30").Select
ElseIf Range("A31") =3D Empty Then
Range("A31").Select
Else
Range("A2").Select
End If
Selection.PasteSpecial Paste:=3DxlValues,=20
Operation:=3DxlNone, SkipBlanks:=3D _
False, Transpose:=3DFalse
End Sub
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Elicend_News
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
Avatar
isabelle
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