Résolu Faire un Copier Coller en vba sur une autre feuille

  • Auteur de la discussion aude2111
  • Date de début
A

aude2111

Habitué
Bonjour

je suis débutante en vba, j'ai un petit problème

j'ai envie de calculer le nombre de sinistre par mois, pour cela j'ai fais le code ci dessus
cependant je ne veux pas qu'il me renvoie de MsgBox mais quil mecrivent la reponse directement sur la feuil 2 (en A2 la premiere ligne je la laisse au titre) pour que moi depuis la feuille 2 je fais un copier coller que je colle sur un autre fichier
Sub test()

Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim DernLigne As Long
Dim nblignes, nblignes1, nblignes2, nblignes3, nblignes4 As Long
Dim nblignes5, nblignes6, nblignes7, nblignes8, nblignes9 As Long
Dim nblignes10, nblignes11 As Long

With Worksheets("Feuil1")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Date_Survenance = .Range("R2:R" & DernLigne)
End With

nblignes = 0
nblignes1 = 0
nblignes2 = 0
nblignes3 = 0
nblignes4 = 0
nblignes5 = 0
nblignes6 = 0
nblignes7 = 0
nblignes8 = 0
nblignes9 = 0
nblignes10 = 0
nblignes11 = 0

a = 2013
b = 2014
c = 2015
d = 2016
e = 2017

jan = 1
fev = 2
mars = 3
avril = 4
mai = 5
juin = 6
juil = 7
aout = 8
sep = 9
oc = 10
nov = 11
dec = 12

For i = 2 To DernLigne
If DateSerial(c, jan, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, jan, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then

nblignes = nblignes + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes

For i = 2 To DernLigne
If DateSerial(c, fev, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, fev, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes1 = nblignes1 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes1

For i = 2 To DernLigne
If DateSerial(c, mars, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, mars, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes2 = nblignes2 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes2

For i = 2 To DernLigne
If DateSerial(c, avril, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, avril, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes3 = nblignes3 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes3

For i = 2 To DernLigne
If DateSerial(c, mai, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, mai, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes4 = nblignes4 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes4

For i = 2 To DernLigne
If DateSerial(c, juin, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, juin, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes5 = nblignes5 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes5

For i = 2 To DernLigne
If DateSerial(c, juil, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, juil, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes6 = nblignes6 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes6

For i = 2 To DernLigne
If DateSerial(c, aout, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, aout, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes7 = nblignes7 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes7

For i = 2 To DernLigne
If DateSerial(c, sep, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, sep, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes8 = nblignes8 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes8

For i = 2 To DernLigne
If DateSerial(c, oc, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, oc, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes9 = nblignes9 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes9

For i = 2 To DernLigne
If DateSerial(c, nov, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, nov, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes10 = nblignes10 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes10

For i = 2 To DernLigne
If DateSerial(c, dec, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, dec, 31) And DateSerial(a, jan, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, dec, 31) Then
nblignes11 = nblignes11 + 1
'Cells(i, 6).Value = 1 'incremente pour voir quel resultat il prend
'Cells(i, 1).Select
End If
Next i
MsgBox "nombre de lignes : " & nblignes11

'Selection.Copy

'Worksheets("Feuil2").Activate

'Destination = Sheets("Feuil2").Range("B1")

End Sub
Cliquez pour agrandir...

 
drul

drul

Obscur pro du hardware
Staff
Meilleure réponse
Salut la réponse à ta question est:
Code: 
Sheets(2).Range("A2").Value=nblignes

Question subsidiaire: mais pourquoi diable fait tu 12 boucles, là ou une seule suffirait ?

N.B.
Dim nblignes, nblignes1, nblignes2, nblignes3, nblignes4 As Long
c'est faux, seule nblignes4 est un "long", les autres sont des "variant" ... pourquoi ne pas utiliser un tableau d'ailleurs ?
 
A

aude2111

Habitué
merci Drul

du coup je met
Code: 
Sheets(2).Range("A2").Value=nblignes

juste après

Code: 
nblignes =nblignes+1


je sais pas comment faire avec une seul boucle
pq juste nblignes4 est un variant
 
A

aude2111

Habitué


mercii Drul sa marche

voici mon code
Code: 
Sub test()

    Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
    Dim DernLigne As Long
    Dim nblignes, nblignes1, nblignes2, nblignes3, nblignes4 As Long
    Dim nblignes5, nblignes6, nblignes7, nblignes8, nblignes9 As Long
    Dim nblignes10, nblignes11 As Long
    
    With Worksheets("Feuil1")
        DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
        Set Date_Survenance = .Range("I2:I" & DernLigne)
    End With
    
    nblignes = 0
    nblignes1 = 0
    nblignes2 = 0
    nblignes3 = 0
    nblignes4 = 0
    nblignes5 = 0
    nblignes6 = 0
    nblignes7 = 0
    nblignes8 = 0
    nblignes9 = 0
    nblignes10 = 0
    nblignes11 = 0
   
    a = 2013
    b = 2014
    c = 2015
    d = 2016
    e = 2017
    
    jan = 1
    fev = 2
    mars = 3
    avril = 4
    mai = 5
    juin = 6
    juil = 7
    aout = 8
    sep = 9
    oc = 10
    nov = 11
    dec = 12
        
        For i = 2 To DernLigne
            If DateSerial(c, jan, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, jan, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes = nblignes + 1
                Sheets("Feuil2").Range("A2").Value = nblignes
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, fev, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, fev, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes1 = nblignes1 + 1
                Sheets("Feuil2").Range("A3").Value = nblignes1
            End If
        Next i
       
       For i = 2 To DernLigne
            If DateSerial(c, mars, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, mars, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes2 = nblignes2 + 1
                Sheets("Feuil2").Range("A4").Value = nblignes2
            End If
        Next i
       
        For i = 2 To DernLigne
            If DateSerial(c, avril, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, avril, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes3 = nblignes3 + 1
                Sheets("Feuil2").Range("A5").Value = nblignes3
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, mai, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, mai, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes4 = nblignes4 + 1
                Sheets("Feuil2").Range("A6").Value = nblignes4
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, juin, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, juin, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes5 = nblignes5 + 1
                Sheets("Feuil2").Range("A7").Value = nblignes5
            End If
        Next i
       
        For i = 2 To DernLigne
            If DateSerial(c, juil, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, juil, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes6 = nblignes6 + 1
                Sheets("Feuil2").Range("A8").Value = nblignes6
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, aout, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, aout, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes7 = nblignes7 + 1
                Sheets("Feuil2").Range("A9").Value = nblignes7
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, sep, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, sep, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes8 = nblignes8 + 1
                Sheets("Feuil2").Range("A10").Value = nblignes8
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, oc, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, oc, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes9 = nblignes9 + 1
                Sheets("Feuil2").Range("A11").Value = nblignes9
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, nov, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, nov, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes10 = nblignes10 + 1
                Sheets("Feuil2").Range("A12").Value = nblignes10
            End If
        Next i
        
        For i = 2 To DernLigne
            If DateSerial(c, dec, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, dec, 31) And DateSerial(a, jan, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, dec, 31) Then
                nblignes11 = nblignes11 + 1
                Sheets("Feuil2").Range("A13").Value = nblignes11
            End If
        Next i
    
End Sub

mais tu peux me montrer ste plais comment faire plus simple avec une seul boucle

merci
 
drul

drul

Obscur pro du hardware
Staff
Un exemple de ce qu'on peut faire pour compacter un poil ...
Code: 
Sub test()

Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim DernLigne As Long
Dim nblignes(1 To 12) As Long
Dim i As Integer
Dim j As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer

With Worksheets(1)
    DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
    Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
    Set Date_Survenance = .Range("R2:R" & DernLigne)
End With
For i = 1 To 12
    nblignes(i) = 0
Next
a = 2013
b = 2014
c = 2015
d = 2016
e = 2017


For i = 2 To DernLigne
    If DateSerial(a, 1, 1) <= Cells(i, 18).Value And Cells(i, 18).Value <= DateSerial(e, 12, 31) Then
        For j = 1 To 12
            If DateSerial(c, j, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(c, j, 31) Then
                nblignes(j) = nblignes(j) + 1
            End If
        Next
Next


For i = 1 To 12
    Sheets(2).Cells(i + 1, 1).Value = nblignes(i)
Next
'Selection.Copy

'Worksheets("Feuil2").Activate

'Destination = Sheets("Feuil2").Range("B1")

End Sub
 
drul

drul

Obscur pro du hardware
Staff
Une variante un peu plus efficace :D

Code: 
Sub test()

Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim DernLigne As Long
Dim nblignes(1 To 12) As Long
Dim i As Integer
Dim j As Integer
'... virer ce qui ne faisait rien dans la macro
For i = 2 To DernLigne
    If 2013 <= Year(Cells(i, 18).Value) And Year(Cells(i, 18).Value) <= 2017 Then
        If Year(Cells(i, 7).Value) = 2015 Then
            j = Month(Cells(i, 7).Value)
            nblignes(j) = nblignes(j) + 1
        End If
    End If
Next

For i = 1 To 12
    Sheets(2).Cells(i + 1, 1).Value = nblignes(i)
Next

End Sub

N.B. l'utilisation de "a b c d e" me semble un peu inutile ... autant utiliser directement la valeur ...
 
A

aude2111

Habitué

 
A

aude2111

Habitué
merciii bcpp sa marche
une toute petite dernière question si sa te dérange pas

si maintenant j'ai envie de faire la même chose pour les 5 année (2013-2017) mais l'année qui va changer c juste pour la colonne 7 l'autre ne bouge pas et sa me calcule pareil pour chaque moi de 2013, chaque mois de 2014... ou je peux placer le
Code: 
for k=2013 to 2017
 
drul

drul

Obscur pro du hardware
Staff
T'as utiliser la version 2 ?
Suivant l'année tu veux le résultat dans une autre feuille, ou une autre colonne ? ou c'est juste une grosse somme par mois, indépendement de l'année ?
 
A

aude2111

Habitué


 
A

aude2111

Habitué
non je veux le résultat a la suite
un somme par mois et année pour la colonne 7
resulat de l'année 2013 pour chaque mois (ceux quon vous avez fait) a la suite
resulat de l'année 2014 pour chaque mois
resulat de l'année 2015 pour chaque mois
resulat de l'année 2016 pour chaque mois
resulat de l'année 2017 pour chaque mois


 
A

aude2111

Habitué
je pensais faire ca mais sa ne marche pas
Code: 
Sub test()

Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim DernLigne As Long
Dim nblignes(1 To 12) As Long
Dim i As Integer
Dim j As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim k As Integer


With Worksheets("Feuil1")
    DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
    Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
    Set Date_Survenance = .Range("I2:I" & DernLigne)
End With

For i = 1 To 12
    nblignes(i) = 0
Next i

a = 2013
b = 2014
c = 2015
d = 2016
e = 2017


For i = 2 To DernLigne
    If DateSerial(a, 1, 1) <= Cells(i, 9).Value And Cells(i, 9).Value <= DateSerial(e, 12, 31) Then
        For k = 2013 To 2014
            For j = 1 To 12
                If DateSerial(k, j, 1) <= Cells(i, 7).Value And Cells(i, 7).Value <= DateSerial(k, j, 31) Then
                    nblignes(j) = nblignes(j) + 1
                End If
            Next j
        Next k
    End If
Next i


For i = 1 To 12
    Sheets("Feuil2").Cells(i + 1, 1).Value = nblignes(i)
Next i


End Sub
 
drul

drul

Obscur pro du hardware
Staff
C'est pas loin ...
Tu veux tous les résultats à la suite dans la colonne 2 de la feuille 2 (A2-A13 pour 2011, A13-A24 pour 2012, ...) ?
 
A

aude2111

Habitué


 
drul

drul

Obscur pro du hardware
Staff
Je te donne la solution avec la V2 que je trouve bien plus élégante, mais le même principe est aussi applicable à la V1 ...
Code: 
Sub test()

Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim DernLigne As Long
Dim nblignes(1 To 12, 2013 To 2017) As Long
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer

With Worksheets(1)
    DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
    Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
    Set Date_Survenance = .Range("R2:R" & DernLigne)
End With
a = LBound(nblignes, 2)
e = UBound(nblignes, 2)
For i = 2 To DernLigne
    If a <= Year(Cells(i, 18).Value) And Year(Cells(i, 18).Value) <= e Then
            j = Month(Cells(i, 7).Value)
            k = Year(Cells(i, 7).Value)
            nblignes(j, k) = nblignes(j, k) + 1
    End If
Next
For k = a To e
    For i = 1 To 12
        Sheets(2).Cells(i + 1 + (k - a) * 12, 1).Value = nblignes(i, k)
    Next
Next
'Selection.Copy

'Worksheets("Feuil2").Activate

'Destination = Sheets("Feuil2").Range("B1")

End Sub
 
A

aude2111

Habitué
merci beaucoup

je comprend pas trop comment on peut utiliser LBound et UBound
 
drul

drul

Obscur pro du hardware
Staff
LBound te donne l'indice le plus bas d'un tableau (ubound le plus haut ...) ici:

LBound(nblignes, 2)
avec l'arguement ",2" on regarde la deuxième dimension de nblignes (donc 2013 to 2017) Lbound nous donne donc 2013.
Ceci permet d'être sur de ne pas avoir des problèmes de consitences (si demain tu veux travailler jusqu'à 2018, tu ne modifies qu'à un seul endroit)
 
A

aude2111

Habitué



 
drul

drul

Obscur pro du hardware
Staff
C'est gentil de toujours me citer, mais pas tres utile ... :o
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 134
Messages
6 718 059
Membres
1 586 394
Dernier membre
Manoushk
Partager cette page
Haut