Discussion :

[fzayoubi]

Bonjour,

j'essaie de copier plusieurs tableaux à partir de différentes feuilles selon condition ( çàd si le mois de la cellule M8 de toutes les feuilles du classeurs égale à la date dans la cellule E5 de l'onglet "Fichier Presta")

alors ces tableaux j'aimerai les coller dans l'onglet "Fichier Presta"

voici mon code. j'arrive à trouver les feuilles que je veux en affichant les noms des feuilles avec un msgbox
mais je n'arrive pas à coller dans la feuille que je veux. quand j’exécute le code ça ne copie/colle pas

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 fichier_presta()
 
 
 Dim ws As Worksheet
 
 For Each ws In ThisWorkbook.Worksheets
    ws.Activate
 
    If Range("E1") = "CS&L Feuille KIT" And ActiveSheet.Name <> "Template KIT" And ActiveSheet.Name <> "Menu" And ActiveSheet.Name <> "Liste des Kits" Then
        If ws.Range("M8") = Worksheets("Fichier Presta").Range("E5") Then 
        MsgBox (ActiveSheet.Name) 'jusqu'ici ça marche
 
        'code du copier coller
        Range("A23:I34").Select '
        Selection.Copy
 
 
        If Worksheets("Fichier Presta").Range("B12") = "" Then
        i = 12
        Else
        i = Worksheets("Fichier Presta").Range("B65535").End(xlUp).Row + 1 
        'i = i + 1
        ActiveSheet.Paste
         End If
 
 
        End If
    End If
Next ws
 
 
 
End Sub

Merci pour votre aide

[Thautheme]

Bonjour Fzayoubi, bonjour le forum,

Peut-être comme ça :

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
Sub fichier_presta()
Dim O As Worksheet
Dim OD As Worksheet
Dim DEST As Range
 
Set OD = Worksheets("Fichier Presta")
For Each O In Worksheets
    Debug.Print O.Name
    If Not O.Name = "Template KIT" And Not O.Name = "Menu" And Not O.Name = "Liste des Kits" Then
        If O.Range("E31") = "CS&L Feuille KIT" Then
             If OD.Cells(12, "B").Value = "" Then Set DEST = Cells(12, "B") Else Set  DEST = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
            O.Range("A23:I34").Copy DEST
        End If
    End If
Next O
End Sub

[Édition]
Modification du code suite a la juste remarque de Marcel...

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
Sub fichier_presta()
Dim O As Worksheet
Dim OD As Worksheet
Dim DEST As Range
 
Set OD = Worksheets("Fichier Presta")
For Each O In Worksheets
    If Not O.Name = "Template KIT" And Not O.Name = "Menu" And Not O.Name = "Liste des Kits" Then
        If O.Range("E31") = "CS&L Feuille KIT" Then
             If OD.Cells(12, "B").Value = "" Then Set DEST = OD.Cells(12,  "B") Else Set  DEST = OD.Cells(Application.Rows.Count,  "B").End(xlUp).Offset(1, 0)
            O.Range("A23:I34").Copy DEST
        End If
    End If
Next O
End Sub

[MarcelG]

Bonjour à vous,

Thautheme, rattache bien toustes objets Range.

Pour ce cas de figure, j'aurais tendance à alimenter une variable tableau dont j'appliquerai la transpositions sur la feuille de destination.

[fzayoubi]

Bonjour Fzayoubi, bonjour le forum,

Peut-être comme ça :

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
Sub fichier_presta()
Dim O As Worksheet
Dim OD As Worksheet
Dim DEST As Range
 
Set OD = Worksheets("Fichier Presta")
For Each O In Worksheets
    Debug.Print O.Name
    If Not O.Name = "Template KIT" And Not O.Name = "Menu" And Not O.Name = "Liste des Kits" Then
        If O.Range("E31") = "CS&L Feuille KIT" Then
             If OD.Cells(12, "B").Value = "" Then Set DEST = Cells(12, "B") Else Set  DEST = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
            O.Range("A23:I34").Copy DEST
        End If
    End If
Next O
End Sub

[Édition]
Modification du code suite a la juste remarque de Marcel...

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
Sub fichier_presta()
Dim O As Worksheet
Dim OD As Worksheet
Dim DEST As Range
 
Set OD = Worksheets("Fichier Presta")
For Each O In Worksheets
    If Not O.Name = "Template KIT" And Not O.Name = "Menu" And Not O.Name = "Liste des Kits" Then
        If O.Range("E31") = "CS&L Feuille KIT" Then
             If OD.Cells(12, "B").Value = "" Then Set DEST = OD.Cells(12,  "B") Else Set  DEST = OD.Cells(Application.Rows.Count,  "B").End(xlUp).Offset(1, 0)
            O.Range("A23:I34").Copy DEST
        End If
    End If
Next O
End Sub

c'est exactement ce que je cherchais ! merci beaucoup tu m'as sauvé la vie

[MarcelG]

Par perfectionnisme:

- Mieux vaut toujours déclarer les arguments d'une méthode

Code :

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

Copy... Destination:=

- Annihiler le mode copie après méthode

Code :

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

Application.CutCopymode = False