copier donnees avec changement de feuilles [Résolu]

[dalo02]

bonjour a tous
je demande votre aide pour ce petit programme
cela marche tres bien pour la premiere feuille , le changement de feuille s'effectue bien mais ce sont toujours les donnees de la 1° feuille qui sont listees
je bute!!! ou est l'erreur ??

voici mon code

merci pour votre aide

Code :

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
 
Sub titi()
Dim sh As Worksheet
Dim cel As Range
Dim i As Long
 
For Each sh In Sheets
sh.Select
'MsgBox sh.Name
sh.Activate
 
For i = 6 To sh.Range("c65536").End(xlUp).Row
 
If Cells(i, 3).Value > 2 Then
Range(Cells(i, 1), Cells(i, 3)).Copy
 
'Copier les donnees dans la feuille T2
 
Sheets("T2").Select
With Sheets("T2")
.Rows("1:1").Select
Selection.Insert Shift:=xlDown
End With
 
End If
 
Next i
Next sh
 
End Sub

[bbil]

ben il y en as plein d'erreur ...

il ne faut pas utiliser .Select, Selection .. Activate ..

lorsque tu utilise Range, Cells , Rows ... il faut préciser la feuille en le précédent par l'objet feuille approprié sh..

[dalo02]

bonjour a tous
je demande votre aide pour ce petit programme
cela marche tres bien pour la premiere feuille , le changement de feuille s'effectue bien mais ce sont toujours les donnees de la 1° feuille qui sont listees
je bute!!! ou est l'erreur ??

voici mon code

merci pour votre aide

Code :

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
Sub titi()
Dim sh As Worksheet
Dim cel As Range
Dim i As Long
 
For Each sh In Sheets
sh.Select
'MsgBox sh.Name
sh.Activate
 
For i = 6 To sh.Range("c65536").End(xlUp).Row
 
If Cells(i, 3).Value > 2 Then
Range(Cells(i, 1), Cells(i, 3)).Copy
 
'Copier les donnees dans la feuille T2
 
Sheets("T2").Select
With Sheets("T2")
.Rows("1:1").Select
Selection.Insert Shift:=xlDown
End With
 
End If
 
Next i
Next sh
 
End Sub

bonjour
c'est vraiment la "cata" mon code?
peux tu m#indiquer ou sont les erreurs
merci
a propos j'ai remis la discution dans le forum VBa

[mercatog]

Evite les Select Activate

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub titi()
Dim Sh As Worksheet
Dim Cel As Range
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
For Each Sh In Sheets
    With Sh
        LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
        For i = 6 To LastLig
            If .Cells(i, 3).Value > 2 Then
                .Range(.Cells(i, 1), .Cells(i, 3)).Copy
                Worksheets("T2").Rows(1).Insert Shift:=xlDown
                Application.CutCopyMode = False
            End If
        Next i
    End With
Next Sh
End Sub

[jfontaine]

Bonjour,

Si tu boucles sur les feuilles en utilisant la variable Sh, il faut penser a s'en servir

Code :

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
Sub titi()
Dim sh As Worksheet
Dim cel As Range
Dim i As Long
 
For Each sh In Sheets
sh.Select
'MsgBox sh.Name
sh.Activate
 
For i = 6 To sh.Range("c65536").End(xlUp).Row
 
If Sh.Cells(i, 3).Value > 2 Then
Sh.Range(Sh.Cells(i, 1), Sh.Cells(i, 3)).Copy
 
'Copier les donnees dans la feuille T2
 
Sheets("T2").Select
With Sheets("T2")
.Rows("1:1").Select
Selection.Insert Shift:=xlDown
End With
 
End If
 
Next i
Next sh

[mercatog]

Il faudrait aussi tester dans la boucle sur Sh pour éviter de copier de T2 vers T2
Sinon, une autre proposition plus rapide qui utilise un filtre automatique

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Toto()
Dim Sh As Worksheet
Dim Cel As Range
Dim LastLig As Long, N As Long
 
Application.ScreenUpdating = False
For Each Sh In ThisWorkbook.Worksheets
    With Sh
        If .Name <> "T2" Then
            .AutoFilterMode = False
            LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
            .Range("C5:C" & LastLig).AutoFilter Field:=1, Criteria1:=">2"
            N = .Range("C6:C" & LastLig).SpecialCells(xlCellTypeVisible).Count
            If N > 0 Then
                Worksheets("T2").Rows(1 & ":" & N).Insert
                .Range("A6:C" & LastLig).SpecialCells(xlCellTypeVisible).Copy Worksheets("T2").Range("A1")
            End If
            .AutoFilterMode = False
        End If
    End With
Next Sh
End Sub

[dalo02]

bonsoir
ca marche super
merci pour vos reponses si rapides
un grand merci a Mercatog
et c'est promis je vais laisser tomber les "select,activate ect..
bonne soiree a tous