Plantage d'un collage ou d'une selection de sheets

**manphenix** · 01/08/2008, 11h14

Bonjour a tous,

Je fait une macro pour trier des données
et recopier certaine ligne sur des nouveaux onglets selon les criteres suivants

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Dim numcol As Integer, numligne As Integer, mois As Integer, annee As Integer
    Dim nbtotalligne As Integer, s As Integer, nbfln As Integer
    Dim nbtotalcol As Integer
    Dim i As Integer, lvrd As Integer, expo As Integer, occa As Integer
    Dim d As Integer
    Dim colat As Integer
    Dim nomongle As String, nomongle2 As String, nomongle1 As String, nomongleexp As String, nomongleocca As String
 
 
 
    lvrd = 2
    occa = 2
    expo = 2
 
    Application.ScreenUpdating = False 'ici c est pour rendre inactif l affichage le travail de la macro
    nomongle1 = InputBox("Bonjour, quel est le nom de l'onglet?", "Et oui, il faut un peu travailler....")
    mois = InputBox("Bonjour, quel est le mois que TU es en train de travailler(mdr..)? bien sûr, les 2 derniers chiffres", "Et oui, encore et encore du travail....")
    annee = InputBox("Bonjour, quel est l'annee? hihihihihihihihihihi! bien sûr, les 2 derniers chiffres", "Et oui, encore et encore du travail....")
 
    If annee < 10 Then
        If mois < 10 Then
            nomongle = "200" & annee & "-0" & mois & " " & "Lvrd" & " reçu"
            nomongle2 = "200" & annee & "-0" & mois & " " & "Lvrd"
            nomongleexp = "200" & annee & "-0" & mois & " " & "Export"
            nomongleocca = "200" & annee & "-0" & mois & " " & "Occas"
        ElseIf mois > 10 Then
            nomongle = "200" & annee & "-" & mois & " " & "Lvrd" & " reçu"
            nomongle2 = "200" & annee & "-" & mois & " " & "Lvrd"
            nomongleexp = "200" & annee & "-" & mois & " " & "Export"
            nomongleocca = "200" & annee & "-" & mois & " " & "Occas"
        End If
    ElseIf annee > 10 Then
        If mois < 10 Then
            nomongle = "20" & annee & "-0" & mois & " " & "Lvrd" & " reçu"
            nomongle2 = "20" & annee & "-0" & mois & " " & "Lvrd"
            nomongleexp = "20" & annee & "-0" & mois & " " & "Export"
            nomongleocca = "20" & annee & "-0" & mois & " " & "Occas"
        ElseIf mois > 10 Then
            nomongle = "20" & annee & "-" & mois & " " & "Lvrd" & " reçu"
            nomongle2 = "20" & annee & "-" & mois & " " & "Lvrd"
            nomongleexp = "20" & annee & "-" & mois & " " & "Export"
            nomongleocca = "20" & annee & "-" & mois & " " & "Occas"
        End If
    End If
    Application.Worksheets(nomongle1).Activate
    ActiveSheet.Name = nomongle
    If Not IsExist(nomongleexp) Then Sheets.Add: ActiveSheet.Name = nomongleexp
    If Not IsExist(nomongleocca) Then Sheets.Add: ActiveSheet.Name = nomongleocca
    If Not IsExist(nomongle2) Then Sheets.Add: ActiveSheet.Name = nomongle2
    Application.Worksheets(nomongle).Activate
    numcol = 1
    nbtotalligne = Compte_nb_lignes_non_caches(numcol)
    colat = 46
    Columns(1).Insert Shift:=xlLeft
    Columns(1).Insert Shift:=xlLeft
    Columns(1).Insert Shift:=xlLeft
    Columns(32).Insert Shift:=xlLeft
    Worksheets(nomongle).Cells(1, 1).Value = "MOIS"
    Worksheets(nomongle).Cells(1, 2).Value = "CAT"
    Worksheets(nomongle).Cells(1, 3).Value = "W de JB"
    Worksheets(nomongle).Cells(1, 32).Value = "CONCESSION"
    s = 0
    For i = 2 To nbtotalligne + 1
    If Worksheets(nomongle).Cells(i, 5).Value = 5 Then
            Worksheets(nomongle).Cells(i, 2).Value = "VP"
            Worksheets(nomongle).Cells(i, 1).Value = mois
            Worksheets(nomongle).Cells(i, 3).Value = "ok"
          ElseIf Worksheets(nomongle).Cells(i, 5).Value = 6 Then
            Worksheets(nomongle).Cells(i, 2).Value = "VP"
            Worksheets(nomongle).Cells(i, 1).Value = mois
            Worksheets(nomongle).Cells(i, 3).Value = "ok"
          ElseIf Worksheets(nomongle).Cells(i, 5).Value = 7 Then
            Worksheets(nomongle).Cells(i, 2).Value = "VP"
            Worksheets(nomongle).Cells(i, 1).Value = mois
            Worksheets(nomongle).Cells(i, 3).Value = "ok"
          ElseIf Worksheets(nomongle).Cells(i, 5).Value = 11 Then
            Worksheets(nomongle).Cells(i, 2).Value = "VU"
            Worksheets(nomongle).Cells(i, 1).Value = mois
            Worksheets(nomongle).Cells(i, 3).Value = "ok"
          ElseIf Worksheets(nomongle).Cells(i, 5).Value = 29 Then
            Worksheets(nomongle).Cells(i, 2).Value = "VU"
            Worksheets(nomongle).Cells(i, 1).Value = mois
            Worksheets(nomongle).Cells(i, 3).Value = "ok"
    End If
    If Worksheets(nomongle).Cells(i, 10).Value Like "toto" Then
            Worksheets(nomongle).Cells(i, 10).Value = "tata"
            ElseIf Worksheets(nomongle).Cells(i, 10).Value Like "titi" Then
            Worksheets(nomongle).Cells(i, 10).Value = "tata"
    End If
    If Worksheets(nomongle).Cells(i, 12).Value Like "lulu" Then
            Worksheets(nomongle).Cells(i, 12).Value = "riri"
            ElseIf Worksheets(nomongle).Cells(i, 12).Value Like "fifi" Then
            Worksheets(nomongle).Cells(i, 12).Value = "riri"
    End If
    If Worksheets(nomongle).Cells(i, 17).Value > 3500 Then
            Worksheets(nomongle).Cells(i, 3).Value = "GROS"
    End If
    If Worksheets(nomongle).Cells(i, 30).Value > 31 And Worksheets(nomongle).Cells(i, 30).Value < 50 Then
            Worksheets(nomongle).Cells(i, 32).Value = 498
            ElseIf Worksheets(nomongle).Cells(i, 30).Value > 60 And Worksheets(nomongle).Cells(i, 30).Value < 69 Then
            Worksheets(nomongle).Cells(i, 32).Value = 212
            ElseIf Worksheets(nomongle).Cells(i, 30).Value > 73 And Worksheets(nomongle).Cells(i, 30).Value < 78 Then
            Worksheets(nomongle).Cells(i, 32).Value = 382
            ElseIf Worksheets(nomongle).Cells(i, 30).Value > 89 And Worksheets(nomongle).Cells(i, 30).Value < 100 Then
            Worksheets(nomongle).Cells(i, 32).Value = 511
            ElseIf Worksheets(nomongle).Cells(i, 30).Value > 69 And Worksheets(nomongle).Cells(i, 30).Value < 74 Then
            Worksheets(nomongle).Cells(i, 32).Value = 512
            ElseIf Worksheets(nomongle).Cells(i, 30).Value > 11 And Worksheets(nomongle).Cells(i, 30).Value < 14 Then
            Worksheets(nomongle).Cells(i, 32).Value = 512
            Else
            Worksheets(nomongle).Cells(i, 32).Value = 79
            End If

ET la oufffff ca marche

Maintenant je souhaite recopier dans un des onglets la ligne qui est en cours de travail!
si j'ai un N je le met dans l onglet dont le nom (qui change chaque mois) est dans la variable nomongle2

Code :

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

1
2
3
4
5
6
7
8
    If Worksheets(nomongle).Cells(i, 3).Value Like "ok" Then
        If Worksheets(nomongle).Cells(i, 4).Value Like "N" Then
        Rows(i).Select
        Selection.Copy
        Worksheets(nomongle2).Rows(lvrd).Paste
        lvrd = lvrd + 1
        EndIf
EndIf

ET LA C EST LE DRAMME : il arrive a copier mais pas à coller

J'ai aussi essayer d'activer la sheets avant et il veut pas

je fini bien sur par:

Code :

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

1
2
3
4
 
    Next i
    Application.ScreenUpdating = True 
End Sub

**ancel17** · 01/08/2008, 11h52

Bonjour,

En remplaçant ton dernier code par ça :

Code :

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

1
2
3
4
5
6
    If Worksheets(nomongle).Cells(i, 3).Value Like "ok" Then
        If Worksheets(nomongle).Cells(i, 4).Value Like "N" Then
        Rows(i).Copy Destination:=Worksheets(nomongle2).Rows(lvrd)
        lvrd = lvrd + 1
        EndIf
EndIf

Chez moi ça fonctionne, mais j'ai pas tout ce qui se passe avant...

**manphenix** · 01/08/2008, 12h01

super

mais peut tu m'expliquer pourquoi ca n'allez pas avant?

merci

**ancel17** · 01/08/2008, 13h49

La méthode Paste s'applique à un objet Worksheet (regarde dans l'aide VBA EXCEL).

Tu aurais aussi pu mettre ce code qui ce rapproche plus de ce que tu avais :

Code :

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

1
2
3
4
5
6
7
8
    If Worksheets(nomongle).Cells(i, 3).Value Like "ok" Then
        If Worksheets(nomongle).Cells(i, 4).Value Like "N" Then
        Rows(i).Select
        Selection.Copy
        Worksheets(nomongle2).Paste Destination:=Worksheets("nomongle2").Rows(lvrd)
        lvrd = lvrd + 1
        End If
    End If

**manphenix** · 04/08/2008, 07h52

merci je comprend mieux

**manphenix** · 05/08/2008, 12h27

Je cherche à coller une selection sur une zone démarrant à la cellule dont le num de ligne est dans une fonction et le num de col est dans une autre.
Ca me donne ca:

Code :

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

1
2
3
4
 
If tableau(0, i) = "Total VP+VU" Then
        Worksheets("Procedure").Range("C18:C77").Copy
        Worksheets(tableau(0, i)).Paste Destination:=Worksheets(tableau(0, i)).Range(Cells(tableau(1, i), tableau(2, i)))

et snif ca ne marche pas................
a oui au fait c'est dans une boucle for car je fait ca pour 6 onglets.

**ancel17** · 06/08/2008, 13h43

Salut,

Remplace

Code :

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

        Worksheets(tableau(0, i)).Paste Destination:=Worksheets(tableau(0, i)).Range(Cells(tableau(1, i), tableau(2, i)))

par

Code :

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

        Worksheets("Total VP+VU").Paste Destination:=Worksheets("Total VP+VU").Range(Cells(tableau(1, i), tableau(2, i)))

Plantage d'un collage ou d'une selection de sheets

Excel

Discussions similaires

Partager

Partager