Besoin d'aide macro copier ligne sous condition

[Zazou15]

Bonjour,

Je suis totalement débutante (voir même nulle) en macro. Je me suis débrouillée en copiant un code que j'ai trouvé dans ce forum. Je voulais copié une ligne de ma feuille1 ("2018") dans ma feuille2 ("Finalisés") lorsque dans la colonne A de ma feuille1 c'est écrit: "Finalisé"

Ça marche! Mais ça me copie seulement les infos des 2 premières colonnes (ce qui est logique parce que la personne au départ avait seulement 2 colonnes dans son tableau. Mais moi j'en ai 8! (A à H) Donc dans les colonnes C à H, c'est inscrit #N/A. Voici mon code:


Sub Transfert()
Dim tablo1, i&, tablo2(), n&
tablo1 = Sheets("2018").Range("A4:H" & Sheets("2018").[A65536].End(xlUp).Row)
For i = 1 To UBound(tablo1)
If tablo1(i, 1) Like "Finalisé" Then
ReDim Preserve tablo2(1, n)
tablo2(0, n) = tablo1(i, 1)
tablo2(1, n) = tablo1(i, 2)
n = n + 1
End If
Next
If n Then
Sheets("Finalisés").[A4:H65536].ClearContents
Sheets("Finalisés").[A4].Resize(n, 8) = Application.Transpose(tablo2)
End If
End Sub

Merci beaucoup!!!

 

[Nairolf]

Salut,

Je te propose la modification suivante (saisi à la volée, donc il peut y avoir des erreurs de frappe) :

Sub Transfert()
Dim tablo1, i&, tablo2(), n&
tablo1 = Sheets("2018").Range("A4:H" & Sheets("2018").[A65536].End(xlUp).Row)
n=0 'ajout initialisation explicite de n
For i = 1 To UBound(tablo1)
If tablo1(i, 1) Like "Finalisé" Then
ReDim Preserve tablo2(1, n)
for j=1 to 8 'ajout boucle
tablo2(j-1, n) = tablo1(i, j) 'Modif pour incrémentation
next j 'ajout boucle
n = n + 1
End If
Next i 'ajout i
If n Then
Sheets("Finalisés").[A4:H65536].ClearContents
Sheets("Finalisés").[A4].Resize(n, 8) = Application.Transpose(tablo2)
End If
End Sub

 

[Zazou15]

Merci beaucoup pour votre réponse rapide! J'ai un message d'erreur qui s'affiche: L'indice n'appartient pas à la sélection.
J'essaye de trouver d'où vient l'erreur mais pas facile quand je ne comprends pas tout le langage utilisé. (Je dois clairement débuter un cours là-dessus) Donc suite à ce message d'erreur, quelle ligne je dois regarder précisément pour trouver la cause de cette erreur?

Merci beaucoup encore une fois!

 

[Nairolf]

La ligne de code concernée est normalement surlignée, qu'elle est-elle?

 

[Zazou15]

Il n'y a malheureusement aucune ligne surlignée. J'ai lancé la macro avec F5 et le message d'erreur apparaît mais c'est tout...

 

[Nairolf]

Salut,

Peux-tu mettre un fichier exemple avec le problème rencontré ?
ça sera plus facile pour moi de voir ce qui cloche.

 

[Zazou15]

Voici mon fichier!
Les 2 lignes en bleues sont celles que j'ai mise à "Finalisé" et dont j'aimerais qu'elles se retrouvent dans le 2e onglet lors de l'activation de la macro. Et dans le meilleur des mondes, j'aimerais que la ligne s'efface dans le premier onglet lorsqu'elle est copiée dans le 2e! Est-ce que c'est possible?
Merci beaucoup de prendre le temps de m'aider

 

[Nairolf]

Le fichier a été enregistré en xlsx au lieu de xlsm, ce qui fait qu'il n'y a pas de code vba enregistré.
Peux-tu renvoyer un fichier avec les macros ?

 

[Rmn]

Bonjour,

l'erreur se trouve au niveau de la boucle avec j
=> ligne tablo2(j - 1,n) = tablo1(i,j)
next j

 

[Nairolf]

Ok,
Dans ce cas là, je pense que ça vient du Redim du tablo2, à corriger avec :

ReDim Preserve tablo2(8, n)

 

[Rmn]

La boucle s'exécute correctement avec la correction apportée, PARFAIT !

merci

 

[Zazou15]

Un immense merci!!!! Tout fonctionne à merveille!!
Merci pour votre aide et votre patience!

 

[Rmn]

Hello, je reviens vers vous, j’ai prêt de 5000 lignes à analyser et 44 colonnes. Les variables sont définies as variant j’imagine, mais ça me met une erreur, j’imagine que l’erreur doit se situer au niveau de la définition des variables, qq’un pourrait me donner un coup de main?
@plus

 

[dr.belguermi]

j ai eu un problem


Sub patho()
Dim tablo1, i&, tablo2(), n&
tablo1 = Sheets("liste").Range("A2:f" & Sheets("liste").[A968].End(xlUp).Row) <----------la ligne ou il y a erreur
n = 0 'ajout initialisation explicite de n
For i = 1 To UBound(tablo1)
If tablo1(i, 1) Like "Yes" Then
ReDim Preserve tablo2(1, n)
For j = 1 To 6 'ajout boucle
tablo2(j - 1, n) = tablo1(i, j) 'Modif pour incrémentation
Next j 'ajout boucle
n = n + 1
End If
Next i 'ajout i
If n Then
Sheets("patho").[A2:f968].ClearContents
Sheets("patho").[A2].Resize(n, 6) = Application.Transpose(tablo2)
End If

End Sub