Nombre de ligne et Inputbox

Version imprimable

bonjour le forum, voilà le code que j'utilise pour copier cetaines valeurs d'un classeur a un autre

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
31
32
33
34
35
36
Private Sub test()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim i As Long, x As Long
Dim Chemin As String
Dim Wb1 As Workbook, Wb2 As Workbook
 
    Set Wb2 = ThisWorkbook
 
    Chemin = ThisWorkbook.Path & "\"
    Workbooks.Open (Chemin & "Rt.xls")
 
    Set Wb1 = Workbooks("Rt.xls")
 
    For Each Sh2 In Wb2.Worksheets
        For Each Sh1 In Wb1.Worksheets
            If Sh1.Name = Sh2.Name Then
 
                With Sh1
 
               LastLig = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
               For i = LastLig To 5 Step -1
                If CDate(Sh1.Cells(i, 3)) = Date Then
                Sh1.Range("d" & i) = Sh2.Range("X12")
                Sh1.Range("e" & i) = Sh2.Range("X10")
                Sh1.Range("h" & i) = Sh2.Range("x13")
                Sh1.Range("i" & i) = Sh2.Range("x11")
                End If
                Next i
 
                End With
 
            End If
        Next Sh1
    Next Sh2
 
End Sub

je veux en fait copier les valeurs sur plusieurs lignes parfois et donc grace à un inputbox dans le quel on entre le nombre de jour pour lequel on copie les memes valeurs exemple: dans l'inputbox on entre 3 la macro cherche donc la date du jour et copie les valeurs pour la date du jour , date + 1 et date + 2 !!! Merci pour votre aide !

22/05/2012, 11h19
Mr.Mof
Bonjour,

Tu peux utiliser les fonctions Now et DateADD qui te permette respectivement d'obtenir la date du jour et d'ajouter un intervalle à une date.

Exemple:
Code:

1 2 3 4 Dim Data as Date Data = Now Data=DateAdd("d",1,Data)
La variable Data sera égale à la date du jour + 1 jour

Cordialement
22/05/2012, 11h24
gFZT82

Bonjour sylvestre09,

Citation:

dans l'inputbox, on entre 3, la macro cherche la date du jour et copie les valeurs pour la date du jour, la date + 1 et la date + 2.

Tu n’indiques pas où se trouvent ces dates (date + 1 et date + 2). Se trouvent-elles dans les cellules suivantes Sh1.Cells(i+1,3) et Sh1.Cells(i+2,3) ou faut-il les chercher ailleurs .. . une autre ligne, une autre colonne ?
Ensuite, quelles sont les cellules correspondantes à copier ?
Pour la date du jour, il s’agissait de Sh2.Range("X12"), Sh2.Range("X10"), etc.
Mais pour les autres dates ?
Mets-toi à la place des intervenants du forum qui n’ont pas le fichier sous les yeux :koi:.

Cordialement.
22/05/2012, 11h56
sylvestre09

Bonjour gFZT82,
oui exactement date, date + 1 et date + 2 se trouvent dans les cellules Sh1.Cells(i,3), Sh1.Cells(i+1,3) et Sh1.Cells(i+2,3) pour les valeurs a copier aussi c'est les memes valeur (Sh2.Range("X12") .....) à mettre dans les cellules [ Sh1.Cells(i,3), Sh1.Cells(i+1,3) et Sh1.Cells(i+2,3) ] tu as tous pigé !! et cela pour tous les onglets donc je pense que l'inputbox doit apparaitre au debut !!
Merci pour ta reponse merci egalement à MrMof !!

Tu peux commencer avec ce code

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
31
32
Private Sub test()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim i As Long, x As Long
Dim Chemin As String
Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb2 = ThisWorkbook
    Chemin = ThisWorkbook.Path & "\"
    Workbooks.Open (Chemin & "Rt.xls")
    Set Wb1 = Workbooks("Rt.xls")
    NbLignes = InputBox("Veuillez indiquer le nombre de dates à copier.", , 1)
    If NbLignes > 0 Then
        For Each Sh2 In Wb2.Worksheets
            For Each Sh1 In Wb1.Worksheets
                If Sh1.Name = Sh2.Name Then
                    With Sh1
                    LastLig = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
                    For i = LastLig To 5 Step -1
                        If CDate(Sh1.Cells(i, 3)) = Date Then
                            For j = 0 To NbLignes - 1
                                Sh1.Range("D" & j + i) = Sh2.Range("X12")
                                Sh1.Range("E" & j + i) = Sh2.Range("X10")
                                Sh1.Range("H" & j + i) = Sh2.Range("X13")
                                Sh1.Range("I" & j + i) = Sh2.Range("X11")
                            Next j
                        End If
                    Next i
                    End With
                End If
            Next Sh1
        Next Sh2
    End If
End Sub

Cordialement.

23/05/2012, 09h56
sylvestre09

Parfait !!! Merciiii :D