Bonjour,
Après de longues recherches, je suis arrivé à ce code qui extrait les données de l'onglet WS1 et les colle dans l'onglet WS3 en fonction d'un critère. Ces données extraites seront collées ensuite dans un Email à envoyer. Le problème se situe au niveau du texte qui ne s'insère pas avant le tableau.
Merci pour votre aide.
Sub ExtraireLignes()
Dim ws1, ws2, ws3 As Worksheet
Dim lastRow1, lastRow2, lastRow3 As Long
Dim filterValue As Variant ' Définir comme Variant
Dim i, j As Long
Dim a As Long ' Utiliser Long plutôt que Integer
Set ws1 = ThisWorkbook.Sheets("Base")
Set ws2 = ThisWorkbook.Sheets("Liste")
Set ws3 = ThisWorkbook.Sheets("Données")
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
lastRow3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row
a = 1
Do Until a = lastRow2
filterValue = ws2.Range("A" & a).Value
For i = 1 To lastRow1 + 1
If ws1.Cells(i, "C").Value = filterValue Then
j = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row + 1
ws1.Rows(i).Copy Destination:=ws3.Rows(j)
End If
Next i
a = a + 1 ' Incrémentation de la variable de boucle
ws3.Select
MsgBox ("Continuer")
Call envoi_mail
ws3.Rows("2:" & ws3.Rows.Count).ClearContents
ws3.Rows("2:" & ws3.Rows.Count).ClearFormats
Loop
End Sub
Après de longues recherches, je suis arrivé à ce code qui extrait les données de l'onglet WS1 et les colle dans l'onglet WS3 en fonction d'un critère. Ces données extraites seront collées ensuite dans un Email à envoyer. Le problème se situe au niveau du texte qui ne s'insère pas avant le tableau.
Merci pour votre aide.
Sub ExtraireLignes()
Dim ws1, ws2, ws3 As Worksheet
Dim lastRow1, lastRow2, lastRow3 As Long
Dim filterValue As Variant ' Définir comme Variant
Dim i, j As Long
Dim a As Long ' Utiliser Long plutôt que Integer
Set ws1 = ThisWorkbook.Sheets("Base")
Set ws2 = ThisWorkbook.Sheets("Liste")
Set ws3 = ThisWorkbook.Sheets("Données")
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
lastRow3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row
a = 1
Do Until a = lastRow2
filterValue = ws2.Range("A" & a).Value
For i = 1 To lastRow1 + 1
If ws1.Cells(i, "C").Value = filterValue Then
j = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row + 1
ws1.Rows(i).Copy Destination:=ws3.Rows(j)
End If
Next i
a = a + 1 ' Incrémentation de la variable de boucle
ws3.Select
MsgBox ("Continuer")
Call envoi_mail
ws3.Rows("2:" & ws3.Rows.Count).ClearContents
ws3.Rows("2:" & ws3.Rows.Count).ClearFormats
Loop
End Sub
