O
olivius
Guest
Bonjour à tous,
Je viens de créer une macro qui permet d'extraire des données et les coller dans un autre onglet.
Maintenant , j'aimerais bien que cette marco puisse ouvrir un autre classeur excel pour aller chercher les infos et les coller dans le classeur de départ (celui où il y a la macro).
Voici mon code.
Dim Ligne As Integer
Ligne = 1
Dim ValeurCellulePrecedente As String
ValeurCellulePrecedente = ""
Dim I As Integer
Dim J As Integer
I = 1
J = 1
Application.ScreenUpdating = False ' Neutraliser l'affichage à l'écran
' **************************************************
ActiveSheet.Select ' sélectionner la feuille affichée : Sheet1 (Feuil1)
FeuilleSource = ActiveSheet.Name ' Attribuer à une variable le nom de la feuille
Sheets.Add ' Créer une feuille de rapport d'extraction DATA
On Error Resume Next ' au cas où la feuille "Extraction" existerait déjà
ActiveSheet.Name = "Extraction" ' Nommer la feuille "Extraction"
Worksheets("Extraction").UsedRange.Clear ' vide la feuille "Extraction" si jamais elle existe déjà
Sheets(FeuilleSource).Select ' retour à la feuille de data
' **************************************************
For Each cell In Worksheets(FeuilleSource).Range("B15", Range("B15").End(xlDown))
If ValeurCellulePrecedente <> cell.Text Then
Worksheets(FeuilleSource).Rows(cell.Row).Copy Destination:=Worksheets("Extraction").Range("A" & Ligne)
Worksheets("Extraction").Range("P" & Ligne).Value = 1
Worksheets("Extraction").Range("P" & Ligne).NumberFormat = "0"
ValeurCellulePrecedente = cell.Text
Ligne = Ligne + 1
Else
Worksheets("Extraction").Range("P" & Ligne - 1).Value = Worksheets("Extraction").Range("P" & Ligne - 1).Value + 1
End If
Next cell
Merci d'avance pour votre aide ! 🙂
Je viens de créer une macro qui permet d'extraire des données et les coller dans un autre onglet.
Maintenant , j'aimerais bien que cette marco puisse ouvrir un autre classeur excel pour aller chercher les infos et les coller dans le classeur de départ (celui où il y a la macro).
Voici mon code.
Dim Ligne As Integer
Ligne = 1
Dim ValeurCellulePrecedente As String
ValeurCellulePrecedente = ""
Dim I As Integer
Dim J As Integer
I = 1
J = 1
Application.ScreenUpdating = False ' Neutraliser l'affichage à l'écran
' **************************************************
ActiveSheet.Select ' sélectionner la feuille affichée : Sheet1 (Feuil1)
FeuilleSource = ActiveSheet.Name ' Attribuer à une variable le nom de la feuille
Sheets.Add ' Créer une feuille de rapport d'extraction DATA
On Error Resume Next ' au cas où la feuille "Extraction" existerait déjà
ActiveSheet.Name = "Extraction" ' Nommer la feuille "Extraction"
Worksheets("Extraction").UsedRange.Clear ' vide la feuille "Extraction" si jamais elle existe déjà
Sheets(FeuilleSource).Select ' retour à la feuille de data
' **************************************************
For Each cell In Worksheets(FeuilleSource).Range("B15", Range("B15").End(xlDown))
If ValeurCellulePrecedente <> cell.Text Then
Worksheets(FeuilleSource).Rows(cell.Row).Copy Destination:=Worksheets("Extraction").Range("A" & Ligne)
Worksheets("Extraction").Range("P" & Ligne).Value = 1
Worksheets("Extraction").Range("P" & Ligne).NumberFormat = "0"
ValeurCellulePrecedente = cell.Text
Ligne = Ligne + 1
Else
Worksheets("Extraction").Range("P" & Ligne - 1).Value = Worksheets("Extraction").Range("P" & Ligne - 1).Value + 1
End If
Next cell
Merci d'avance pour votre aide ! 🙂