Discussion :

[derech]

Bonjour, j'ai une erreur dans le code et je ne sais pas comment la résoudre.
Est-ce que à vue d'oeil quelqu'un voit mon erreur?Merci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub test()
 
Dim i As Integer
Dim k As Integer
Dim derli As Integer
Dim cel As Range
Dim sh As Worksheet
Dim x As String
Dim recherche As Range
x = "YES"
k = 8
 
Set sh = Worksheets("data")
    With sh
       For Each cel In sh.Range("v5:v" & sh.Range("v5").End(xlDown).Row)
        Set recherche = cel.Find(x)
        Next cel
    End With
 
derli = Columns(1).Find("*", , , , , xlPrevious).Row
        For i = 5 To derli
            If Cells(i, 22).Value = x Then
            sh.Range("a&i, n&i, o&i, al&i, ad&i, ae&i, af&i, ag&i, ah&i, ai&i, am&i, an&i, ao&i, ar&i, as&i, at&i, ak&i, aj&i, m&i").Select
            Selection.Copy
            Worksheets("Fully Redeemed").Activate
            Cells(k, 1).Activate
            ActiveSheet.Paste
            End If
        Next i
    i = i + 1
    k = k + 1
End Sub

le debogeur inscrit pour la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
sh.Range("a&i, n&i, o&i, al&i, ad&i, ae&i, af&i, ag&i, ah&i, ai&i, am&i, an&i, ao&i, ar&i, as&i, at&i, ak&i, aj&i, m&i").Select

error 1004
method 'range' of object'_worksheet'failed

J'ai essayé avec juste: Range("a&i....m&i").select mais ca me donne également une erreur

[scully2501]

Pourquoi ne mets tu pas?
a la place de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
sh.Range("a&i, n&i, o&i, al&i, ad&i, ae&i, af&i, ag&i, ah&i, ai&i, am&i, an&i, ao&i, ar&i, as&i, at&i, ak&i, aj&i, m&i").Select

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
dim rang1 as string
rang1 = "a" + CStr(i) + ":" + "m" + CStr(i)
sh.Range(rang1).Select

tu ne peux mélanger des string avec des integer donc il faut faire une conversion des integer en string

[patbou]

bonjour,

adapte ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Worksheets(1).Range("a" & i & ",n" & i & ",p" & i).Activate

[Lou Pitchoun]

Salut,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sh.Range("a" & i, "n" & i, ..., "m" & i).Select

[fred65200]

bonjour à tous

la ligne complète

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
sh.Range("a" & i & ", n" & i & ", o" & i & _
  ", al" & i & ", ad" & i & ", ae" & i & ", af" & _
  i & ", ag" & i & ", ah" & i & ", ai" & i & ", am" & _
  i & ", an" & i & ", ao" & i & ", ar" & i & ", as" & _
  i & ", at" & i & ", ak" & i & ", aj" & i & ", m" & i).Select

cordialement

[ouskel'n'or]

A quoi te sert la boucle ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
       For Each cel In sh.Range("v5:v" & sh.Range("v5").End(xlDown).Row)
            Set recherche = cel.Find(x)
       Next cel

Ensuite, les cellules que tu colles après copies seront dans des colonne consécutives. Est-ce que tu veux ?
Si oui, tu peux simplifier ton code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Set sh = Worksheets("data")
'là tu cherches la dernière ligne de la colonne 1 et lance la recherche sur cette colonne, ok ?
derli = Columns(1).Find("*", , , , , xlPrevious).Row
      For each Cell in sh.range("A5:A" & DerLig)
            If Cell.offset(0,22).value = x Then _
            sh.Range("a&i, n&i, o&i, al&i, ad&i, ae&i, af&i, ag&i, ah&i, ai&i, am&i, an&i, ao&i, ar&i, as&i, at&i, ak&i, aj&i, m&i").Copy Worksheets("Fully Redeemed").Cells(k, 1)
      Next

Mais comme je te l'ai dit, le résultat de ta copie se trouvera dans des colonnes consécutives.
Si tu veux utiliser Find (plus rapide) la syntaxe est différente (!)
Pour aller vite, un exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
With sh.range("A5:A" & DerLig)
     Set c = .find(x)
     if not c is nothing then
sh.Range("a&i, n&i, o&i, al&i, ad&i, ae&i, af&i, ag&i, ah&i, ai&i, am&i, an&i, ao&i, ar&i, as&i, at&i, ak&i, aj&i, m&i").Copy Worksheets("Fully Redeemed").Cells(k, 1)
         else
              'donnée non trouvée
      endif
end with

Bonne après-midi

[derech]

Merci à tous pour la rapidité de vos réponses.

Voila le code que je garde car c'est plus simple pour moi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Sub test2()
 
Dim i As Integer
Dim k As Integer
Dim derli As Integer
Dim cel As Range
Dim sh As Worksheet
Dim x As String
Dim recherche As Range
x = "YES"
k = 8
 
Set sh = Worksheets("data")
 
derli = Columns(1).Find("*", , , , , xlPrevious).Row
        For i = 5 To derli
        Worksheets("data").Activate
            If Cells(i, 22).Value = x Then
            sh.Range("a" & i & ", n" & i & ", o" & i & _
            ", al" & i & ", ad" & i & ", ae" & i & ", af" & _
            i & ", ag" & i & ", ah" & i & ", ai" & i & ", am" & _
            i & ", an" & i & ", ao" & i & ", ar" & i & ", as" & _
            i & ", at" & i & ", ak" & i & ", aj" & i & ", m" & i).Select
            Selection.Copy
            Worksheets("FB Fully Redeemed").Activate
            Cells(k, 1).Activate
            ActiveSheet.Paste
            End If
            k = k + 1
        Next i
    i = i + 1
 
End Sub

Le code fonctionne bien mais le probleme est le suivant:

les cellules que je colle apres copie ne sont pas dans des lignes consécutives et donc j'ai des lignes vident qui s'intercallent.

J'ai rajouté le code suivant pour supprimer ces lignes mais la encore j'ai une erreur de type mismatch

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub SupprimerBlanks()
 
derli = Columns(1).Find("*", , , , , xlPrevious).Row
 
    For i = derli To 8 Step -1
        If Rows(i).Value = Empty Then
        Rows(i).Delete Shift:=xlUp
        End If
    Next i
 
End Sub

Mon erreur est sur cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
If Rows(i).Value = Empty Then

[Lou Pitchoun]

Il faut que tu fasses un collage spécial :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ActiveSheet.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=False

[derech]

J'ai rectifié mon erreur pour les lignes vides qui s'intercallent et je viens de comprendre mon autre erreur, que m'a fai remarquer ouskel'n'or concernant les colonnes consécutives:

Ensuite, les cellules que tu colles après copies seront dans des colonne consécutives. Est-ce que tu veux ?
Si oui, tu peux simplifier ton code

En effet je ne veux pas que les copies de mes cellules soient dans des colonnes consécutives.

Il faut que tu fasses un collage spécial :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ActiveSheet.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=False

je viens de le faire mais j'ai une erreur 1004: application defined or object defined error

J'apporte une précision parceque je n'ai pas été très clair.
Je veux que mes cellules se collent dans l'ordre que je les ai copié

Dans Worksheets("FB Fully Redeemed") en colonne A je veux mes cellules de la collone A du Worksheets("data"). En colonne B je veux mes cellules de la colonne "n" du Worksheets("data") et ainsi de suite.

[scully2501]

J'ai rectifié mon erreur pour les lignes vides qui s'intercallent et je viens de comprendre mon autre erreur, que m'a fai remarquer ouskel'n'or concernant les colonnes consécutives:




En effet je ne veux pas que les copies de mes cellules soient dans des colonnes consécutives.

Lou Pitchoun


je viens de le faire mais j'ai une erreur 1004: application defined or object defined error

Peux tu STP nous montrer ton code en entier?

[derech]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Sub test2()
 
Dim i As Integer
Dim k As Integer
Dim derli As Integer
Dim sh As Worksheet
Dim x As String
x = "YES"
k = 8
 
Set sh = Worksheets("data")
 
derli = Columns(1).Find("*", , , , , xlPrevious).Row
 
        For i = 5 To derli
        Worksheets("data").Activate
            If Cells(i, 22).Value = x Then
            sh.Range("a" & i & ", n" & i & ", o" & i & _
            ", al" & i & ", ad" & i & ", ae" & i & ", af" & _
            i & ", ag" & i & ", ah" & i & ", ai" & i & ", am" & _
            i & ", an" & i & ", ao" & i & ", ar" & i & ", as" & _
            i & ", at" & i & ", ak" & i & ", aj" & i & ", m" & i).Select
            Selection.Copy
            Worksheets("FB Fully Redeemed").Activate
            Cells(k, 1).Activate
            ActiveSheet.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=False
            k = k + 1
            End If
        Next i
    i = i + 1
 
End Sub

[scully2501]

Remplace

Cells(k, 1).Activate

par

Cells(k, 1).Select

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 
 Cells(k, 1).Select
 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=False

Pour moi j'ai testé et ca marche.

[derech]

j'ai toujours une erreur (disconnected on its client) sur la ligne Pastespecial

voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Sub test2()
 
Dim i As Integer
Dim k As Integer
Dim derli As Integer
Dim sh As Worksheet
Dim x As String
x = "YES"
k = 8
 
Set sh = Worksheets("data")
 
derli = Columns(1).Find("*", , , , , xlPrevious).Row
 
        For i = 5 To derli
        Worksheets("data").Activate
            If Cells(i, 22).Value = x Then
            sh.Range("a" & i & ", n" & i & ", o" & i & _
            ", al" & i & ", ad" & i & ", ae" & i & ", af" & _
            i & ", ag" & i & ", ah" & i & ", ai" & i & ", am" & _
            i & ", an" & i & ", ao" & i & ", ar" & i & ", as" & _
            i & ", at" & i & ", ak" & i & ", aj" & i & ", m" & i).Select
            Selection.Copy
            Worksheets("FB Fully Redeemed").Activate
            Cells(k, 1).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            True, Transpose:=False
            k = k + 1
            End If
        Next i
    i = i + 1
 
End Sub

[scully2501]

Bizarre mon code marche est ce qu'il plante à la 1ere boucle ou apres?

[derech]

Cela vient peut etre du fait que dans mon classeur data j'ai des formules un peu partout?

Ca plante a la premiere boucle oui

[scully2501]

Peux tu joindre ton fichier excel pour voir?

[derech]

Non ce n'est pas évident, c'est un fichier avec des infos confidentielles. Je vais voir si je peux mieux expliquer mon problème

[ouskel'n'or]

Je n'avais même pas vu ça : Tu ne peux pas définir une plage de cette manière.
Pour lier plusieurs cellules dans un range, tu dois utiliser Union. Je ne vais pas ré-écrire tout ton code alors voilà ce qui fonctionne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim sh As Worksheet, adres
Set sh = Worksheets("feuil1")
i = 5
        Worksheets("feuil1").Activate
            If Cells(i, 22).Value = X Then
                adres = Application.Union(Range("a" & i), Range("n" & i), _
                Range("al" & i), Range("ad" & i), Range("ae" & i), Range("af" & i), _
                Range("ag" & i), Range("ah" & i), Range("ai" & i), Range("am" & i), _
                Range("an" & i), Range("ao" & i), Range("ar" & i), Range("as" & i), _
                Range("at" & i), Range("ak" & i), Range("aj" & i), Range("m" & i)).Address
                Debug.Print adres
                sh.Range(adres).Copy _
                Worksheets("Feuil4").Cells(1, 1)
            End If

Il y a une autre manière de l'écrire mais celle-ci est orthodoxe et en plus tu n'as pas besoin de t'encombrer de pastespecial, puisque tu utilises Paste:=xlPasteAll
Copy....... destination:=Worksheets("Feuil4").Cells(1, 1)
suffit et comme "destination:=" est facultatif, tu n'en as pas besoin non plus.
Et c'est beaucoup plus simple que ce que tu as écrit
Tu as juste à adapter et à vérifier les adresses que j'ai mises
Bonne soirée

[derech]

Merci ouskel'n'or,

j'ai toujours le meme problème et ne parviens pas à le résoudre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub test2()
'erreur lors du collage, mes copies se collent dans des colonnes consécutives
Dim i As Integer
Dim k As Integer
Dim derli As Integer
Dim sh As Worksheet
Dim x As String
x = "YES"
k = 8
 
Set sh = Worksheets("data")
 
derli = Columns(1).Find("*", , , , , xlPrevious).Row
 
        For i = 5 To derli
        Worksheets("data").Activate
            If Cells(i, 22).Value = x Then
            adres = Application.Union(Range("a" & i), Range("n" & i), _
                Range("o" & i), Range("al" & i), Range("ad" & i), Range("ae" & i), Range("af" & i), _
                Range("ag" & i), Range("ah" & i), Range("ai" & i), Range("am" & i), _
                Range("ag" & i), Range("ah" & i), Range("ai" & i), Range("am" & i), Range("an" & i), Range("ao" & i), Range("ar" & i), Range("as" & i), _
                Range("at" & i), Range("ak" & i), Range("aj" & i), Range("m" & i)).Address
                Debug.Print adres
                sh.Range(adres).Copy _
                Worksheets("FB Fully Redeemed").Cells(k, 1)
 
                k = k + 1
            End If
        Next i
    i = i + 1
 
End Sub

Au moment ou je colle mes cellules elles ne se mettent pas dans l'ordre que j'ai définie dans ma plage. Ex: ma cellule ("m"&i) (que je définie en dernier dans ma plage de cellule) se colle en colonne B alors que je veux qu'elle se colle dans la dernière colonne (en l'occurence la colonne s)

[fred65200]

bonjour,
a tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
 
 
Sub test2()
 
Dim i As Integer
Dim k As Integer
Dim derli As Integer
Dim cel As Range
Dim sh As Worksheet
Dim x As String
Dim recherche As Range
x = "YES"
k = 8
 
Set sh = Worksheets("data")
 
derli = Columns(1).Find("*", , , , , xlPrevious).Row
        For i = 5 To derli
        'Worksheets("data").Activate 'peut être pas nécessaire d'activer la feuille à chaque fois
            If Cells(i, 22).Value = x Then
              Dim tab1(1 To 19, 1 To 1) As Variant
              Erase tab1
              tab1(1, 1) = sh.Range("a" & i).Value
              tab1(2, 1) = sh.Range("n" & i).Value
              tab1(3, 1) = sh.Range("o" & i).Value
              tab1(4, 1) = sh.Range("al" & i).Value
              tab1(5, 1) = sh.Range("ad" & i).Value
              tab1(6, 1) = sh.Range("ae" & i).Value
              tab1(7, 1) = sh.Range("af" & i).Value
              tab1(8, 1) = sh.Range("ag" & i).Value
              tab1(9, 1) = sh.Range("ah" & i).Value
              tab1(10, 1) = sh.Range("ai" & i).Value
              tab1(11, 1) = sh.Range("am" & i).Value
              tab1(12, 1) = sh.Range("an" & i).Value
              tab1(13, 1) = sh.Range("ao" & i).Value
              tab1(14, 1) = sh.Range("ar" & i).Value
              tab1(15, 1) = sh.Range("as" & i).Value
              tab1(16, 1) = sh.Range("at" & i).Value
              tab1(17, 1) = sh.Range("ak" & i).Value
              tab1(18, 1) = sh.Range("aj" & i).Value
              tab1(19, 1) = sh.Range("m" & i).Value
              Worksheets("FB Fully Redeemed").Select
              Range(Cells(k, 1), Cells(k, 19)).Value = Application.Transpose(tab1)
 
            End If
            k = k + 1
        Next i
    i = i + 1
 
End Sub

cordialement