Slt chers excelnautes !
J'ai reçu ce code hier de JP14 pour résoudre un pb. J'aimerai l'adapter à mon fichier normal mais je n'y arrive pas. Pourriez vous SVP m'aider à le comprendre en le commentant ?
Merci d'avance.
Option Explicit
'
Dim nomfeuille1 As String
Dim col1 As String
Dim lidep1 As Long
Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String
Dim data1 As String
Dim chemin As String
Dim classeur1 As String
Dim date1 As Date
Dim date2 As Date
Dim nb As Integer
Dim trouve As Boolean
Dim sh As Worksheet
Dim j As Long
Private Sub CommandButton1_Click()
Unload Me
End Sub
'-------------------------------------------------------------------------------------
' Module : UserForm1/CommandButton2_Click
' DateTime : 20/11/2008 / 19:29
' Auteur : JP14
' Bouton :valider
'-------------------------------------------------------------------------------------
Private Sub CommandButton2_Click()
Dim i As Long
Dim j As Long
Dim dl1 As Long
Dim dl2 As Long
Dim cellule As Range
Dim plage As Range
Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String
Dim date1 As Date
Dim date2 As Date
'**********************************
dl1 = Sheets(nomfeuille1).Range("a65536").End(xlUp).Row + 2
nomfeuille2 = "Feuil2" '"Feuil1"
col2 = "a"
lidep2 = 2
dl2 = Sheets(nomfeuille2).Range("a65536").End(xlUp).Row + 1
'************************************
If IsDate(ComboBox1.Value) Then
date1 = ComboBox1.Value
Else
Call MsgBox("Date de début non conforme" _
& vbCrLf & "" _
, vbCritical, Application.Name)
Exit Sub
End If
If IsDate(ComboBox2.Value) Then
date2 = ComboBox2.Value
Else
Call MsgBox("Date de fin non conforme" _
& vbCrLf & "" _
, vbCritical, Application.Name)
Exit Sub
End If
With Sheets(nomfeuille1)
Set plage = .Range(col1 & lidep1 & ":" & col1 & .Range(col1 & "65536").End(xlUp).Row)
For Each cellule In plage
If IsDate(cellule.Value) Then
If date1 <= cellule.Value And cellule.Value <= date2 Then
' dans la plage on copie
Call ajoutlig(nomfeuille2, "a", nomfeuille1, cellule.Row)
End If
End If
Next cellule
End With
End Sub
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
ComboBox1.Clear
ComboBox2.Clear
ComboBox1.Style = fmStyleDropDownCombo
ComboBox2.Style = fmStyleDropDownCombo
'Récupère les données de la colonne g...
With Sheets(nomfeuille1)
For j = lidep1 To .Range("AB65536").End(xlUp).Row
If ComboBox1.ListCount > 0 Then ComboBox1.Value = Sheets(nomfeuille1).Range("AB" & j)
'...et filtre les doublons
If ComboBox1.ListIndex = -1 Then
ComboBox1.AddItem .Range("AB" & j)
ComboBox2.AddItem .Range("AB" & j)
End If
Next j
End With
End If
ComboBox1.Value = ""
ComboBox1.Style = fmStyleDropDownList
ComboBox2.Style = fmStyleDropDownList
col1 = "AB"
End Sub
Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then
ComboBox1.Style = fmStyleDropDownCombo
ComboBox2.Style = fmStyleDropDownCombo
'Récupère les données de la colonne g...
With Sheets(nomfeuille1)
ComboBox1.Clear
ComboBox2.Clear
For j = lidep1 To Range("Ad65536").End(xlUp).Row
If ComboBox1.ListCount > 0 Then ComboBox1.Value = .Range("AB" & j)
'ComboBox1.Value = .Range("Ad" & j)
'...et filtre les doublons
If ComboBox1.ListIndex = -1 Then
ComboBox1.AddItem .Range("Ad" & j)
ComboBox2.AddItem .Range("Ad" & j)
End If
Next j
End With
End If
col1 = "AD"
ComboBox1.Value = ""
ComboBox1.Style = fmStyleDropDownList
ComboBox2.Style = fmStyleDropDownList
End Sub
Private Sub UserForm_Initialize()
nomfeuille1 = "Feuil2"
lidep1 = 2
End Sub
Private Sub ajoutlig(£nomdest As String, £col As String, £nomorigine As String, £ligacop As Long)
' call ajoutlig( "feuille destination", "colonne pour trouver la dernière ligne", "feuille origine", "ligne à copier")
With Sheets(£nomdest)
Sheets(£nomorigine).Rows(£ligacop).Copy _
Destination:=.Rows(.Range(£col & "65536").End(xlUp).Row + 1)
End With
End Sub
J'ai reçu ce code hier de JP14 pour résoudre un pb. J'aimerai l'adapter à mon fichier normal mais je n'y arrive pas. Pourriez vous SVP m'aider à le comprendre en le commentant ?
Merci d'avance.
Option Explicit
'
Dim nomfeuille1 As String
Dim col1 As String
Dim lidep1 As Long
Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String
Dim data1 As String
Dim chemin As String
Dim classeur1 As String
Dim date1 As Date
Dim date2 As Date
Dim nb As Integer
Dim trouve As Boolean
Dim sh As Worksheet
Dim j As Long
Private Sub CommandButton1_Click()
Unload Me
End Sub
'-------------------------------------------------------------------------------------
' Module : UserForm1/CommandButton2_Click
' DateTime : 20/11/2008 / 19:29
' Auteur : JP14
' Bouton :valider
'-------------------------------------------------------------------------------------
Private Sub CommandButton2_Click()
Dim i As Long
Dim j As Long
Dim dl1 As Long
Dim dl2 As Long
Dim cellule As Range
Dim plage As Range
Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String
Dim date1 As Date
Dim date2 As Date
'**********************************
dl1 = Sheets(nomfeuille1).Range("a65536").End(xlUp).Row + 2
nomfeuille2 = "Feuil2" '"Feuil1"
col2 = "a"
lidep2 = 2
dl2 = Sheets(nomfeuille2).Range("a65536").End(xlUp).Row + 1
'************************************
If IsDate(ComboBox1.Value) Then
date1 = ComboBox1.Value
Else
Call MsgBox("Date de début non conforme" _
& vbCrLf & "" _
, vbCritical, Application.Name)
Exit Sub
End If
If IsDate(ComboBox2.Value) Then
date2 = ComboBox2.Value
Else
Call MsgBox("Date de fin non conforme" _
& vbCrLf & "" _
, vbCritical, Application.Name)
Exit Sub
End If
With Sheets(nomfeuille1)
Set plage = .Range(col1 & lidep1 & ":" & col1 & .Range(col1 & "65536").End(xlUp).Row)
For Each cellule In plage
If IsDate(cellule.Value) Then
If date1 <= cellule.Value And cellule.Value <= date2 Then
' dans la plage on copie
Call ajoutlig(nomfeuille2, "a", nomfeuille1, cellule.Row)
End If
End If
Next cellule
End With
End Sub
Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
ComboBox1.Clear
ComboBox2.Clear
ComboBox1.Style = fmStyleDropDownCombo
ComboBox2.Style = fmStyleDropDownCombo
'Récupère les données de la colonne g...
With Sheets(nomfeuille1)
For j = lidep1 To .Range("AB65536").End(xlUp).Row
If ComboBox1.ListCount > 0 Then ComboBox1.Value = Sheets(nomfeuille1).Range("AB" & j)
'...et filtre les doublons
If ComboBox1.ListIndex = -1 Then
ComboBox1.AddItem .Range("AB" & j)
ComboBox2.AddItem .Range("AB" & j)
End If
Next j
End With
End If
ComboBox1.Value = ""
ComboBox1.Style = fmStyleDropDownList
ComboBox2.Style = fmStyleDropDownList
col1 = "AB"
End Sub
Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then
ComboBox1.Style = fmStyleDropDownCombo
ComboBox2.Style = fmStyleDropDownCombo
'Récupère les données de la colonne g...
With Sheets(nomfeuille1)
ComboBox1.Clear
ComboBox2.Clear
For j = lidep1 To Range("Ad65536").End(xlUp).Row
If ComboBox1.ListCount > 0 Then ComboBox1.Value = .Range("AB" & j)
'ComboBox1.Value = .Range("Ad" & j)
'...et filtre les doublons
If ComboBox1.ListIndex = -1 Then
ComboBox1.AddItem .Range("Ad" & j)
ComboBox2.AddItem .Range("Ad" & j)
End If
Next j
End With
End If
col1 = "AD"
ComboBox1.Value = ""
ComboBox1.Style = fmStyleDropDownList
ComboBox2.Style = fmStyleDropDownList
End Sub
Private Sub UserForm_Initialize()
nomfeuille1 = "Feuil2"
lidep1 = 2
End Sub
Private Sub ajoutlig(£nomdest As String, £col As String, £nomorigine As String, £ligacop As Long)
' call ajoutlig( "feuille destination", "colonne pour trouver la dernière ligne", "feuille origine", "ligne à copier")
With Sheets(£nomdest)
Sheets(£nomorigine).Rows(£ligacop).Copy _
Destination:=.Rows(.Range(£col & "65536").End(xlUp).Row + 1)
End With
End Sub