Bonjour a tous,
Quelqu'un peut il m'expliquer pourquoi un code tapé dans ThisWorkbook :
Private Sub Workbook_Open()
Dim DerLig As Long
Dim Cel1 As Range
Dim firstaddress As String, FichSource As String
Application.ScreenUpdating = False
'If Sheets("Feuille de monte").Range("Q3") = 0 Then Exit Sub
FichSource = ThisWorkbook.Name
Workbooks.Open Filename:="C:\CHE adhérents\mailing.xls"
Workbooks(FichSource).Activate
DerLig = Workbooks("mailing.xls").Sheets("Feuil1").Range("A65500").End(xlUp).Row + 1
With Workbooks("mailing.xls").Sheets("Feuil1")
'***Recherche si adhérent existe déjà
Set Cel1 = .Range("A2:A" & DerLig).Find(Range("L2").Value)
If Not Cel1 Is Nothing Then
firstaddress = Cel1.Address
If Cel1.Offset(0, 1) <> Range("M2").Value Then
Do
Set Cel1 = .Range("A2:A" & DerLig).FindNext(Cel1)
If Cel1.Offset(0, 1) = Range("M2").Value Then DerLig = Cel1.Row
Loop While Not Cel1 Is Nothing And Cel1.Address <> firstaddress
End If
DerLig = Cel1.Row
End If
'***Renseigne le fichier mailing
For j = 1 To 6
.Cells(DerLig, j).Value = Cells(2, 11 + j).Value
Next
End With
Workbooks("mailing.xls").Activate
ActiveWorkbook.save
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub
Fonctionne très bien à l'ouverture du fichier.
Alors que le meme code affecté à un macro ne fonctionne pas ???
Sub suite()
Dim DerLig As Long
Dim Cel1 As Range
Dim firstaddress As String, FichSource As String
Application.ScreenUpdating = False
'If Sheets("Feuille de monte").Range("Q3") = 0 Then Exit Sub
FichSource = ThisWorkbook.Name
Workbooks.Open Filename:="C:\CHE adhérents\mailing.xls"
Workbooks(FichSource).Activate
DerLig = Workbooks("mailing.xls").Sheets("Feuil1").Range("A65500").End(xlUp).Row + 1
With Workbooks("mailing.xls").Sheets("Feuil1")
'***Recherche si adhérent existe déjà
Set Cel1 = .Range("A2:A" & DerLig).Find(Range("L2").Value)
If Not Cel1 Is Nothing Then
firstaddress = Cel1.Address
If Cel1.Offset(0, 1) <> Range("M2").Value Then
Do
Set Cel1 = .Range("A2:A" & DerLig).FindNext(Cel1)
If Cel1.Offset(0, 1) = Range("M2").Value Then DerLig = Cel1.Row
Loop While Not Cel1 Is Nothing And Cel1.Address <> firstaddress
End If
DerLig = Cel1.Row
End If
'***Renseigne le fichier mailing
For j = 1 To 6
.Cells(DerLig, j).Value = Cells(1, 11 + j).Value
Next
End With
Workbooks("mailing.xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub
Merci pour vos réponses
Quelqu'un peut il m'expliquer pourquoi un code tapé dans ThisWorkbook :
Private Sub Workbook_Open()
Dim DerLig As Long
Dim Cel1 As Range
Dim firstaddress As String, FichSource As String
Application.ScreenUpdating = False
'If Sheets("Feuille de monte").Range("Q3") = 0 Then Exit Sub
FichSource = ThisWorkbook.Name
Workbooks.Open Filename:="C:\CHE adhérents\mailing.xls"
Workbooks(FichSource).Activate
DerLig = Workbooks("mailing.xls").Sheets("Feuil1").Range("A65500").End(xlUp).Row + 1
With Workbooks("mailing.xls").Sheets("Feuil1")
'***Recherche si adhérent existe déjà
Set Cel1 = .Range("A2:A" & DerLig).Find(Range("L2").Value)
If Not Cel1 Is Nothing Then
firstaddress = Cel1.Address
If Cel1.Offset(0, 1) <> Range("M2").Value Then
Do
Set Cel1 = .Range("A2:A" & DerLig).FindNext(Cel1)
If Cel1.Offset(0, 1) = Range("M2").Value Then DerLig = Cel1.Row
Loop While Not Cel1 Is Nothing And Cel1.Address <> firstaddress
End If
DerLig = Cel1.Row
End If
'***Renseigne le fichier mailing
For j = 1 To 6
.Cells(DerLig, j).Value = Cells(2, 11 + j).Value
Next
End With
Workbooks("mailing.xls").Activate
ActiveWorkbook.save
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub
Fonctionne très bien à l'ouverture du fichier.
Alors que le meme code affecté à un macro ne fonctionne pas ???
Sub suite()
Dim DerLig As Long
Dim Cel1 As Range
Dim firstaddress As String, FichSource As String
Application.ScreenUpdating = False
'If Sheets("Feuille de monte").Range("Q3") = 0 Then Exit Sub
FichSource = ThisWorkbook.Name
Workbooks.Open Filename:="C:\CHE adhérents\mailing.xls"
Workbooks(FichSource).Activate
DerLig = Workbooks("mailing.xls").Sheets("Feuil1").Range("A65500").End(xlUp).Row + 1
With Workbooks("mailing.xls").Sheets("Feuil1")
'***Recherche si adhérent existe déjà
Set Cel1 = .Range("A2:A" & DerLig).Find(Range("L2").Value)
If Not Cel1 Is Nothing Then
firstaddress = Cel1.Address
If Cel1.Offset(0, 1) <> Range("M2").Value Then
Do
Set Cel1 = .Range("A2:A" & DerLig).FindNext(Cel1)
If Cel1.Offset(0, 1) = Range("M2").Value Then DerLig = Cel1.Row
Loop While Not Cel1 Is Nothing And Cel1.Address <> firstaddress
End If
DerLig = Cel1.Row
End If
'***Renseigne le fichier mailing
For j = 1 To 6
.Cells(DerLig, j).Value = Cells(1, 11 + j).Value
Next
End With
Workbooks("mailing.xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub
Merci pour vos réponses