Extraction en valeur dans un nouveau fichier
Bonjour tout le monde !
J’aurais besoin de votre aide pour une macro que je n’arrive pas à réaliser.
Je voudrais extraire en valeur les onglets « Analyse1 » et « Analyse2 » du fichier en pj (qui est un exemple) dans un nouveau classeur et cela pour chaque entreprise.
Donc obtenir un nouveau fichier dans lequel on retrouve :
- Un onglet analyse1 et analyse2 avec les données de l’entreprise A
- Un onglet analyse1 et analyse2 avec les données de l’entreprise B
- Un onglet analyse1 et analyse2 avec les données de l’entreprise C
- Etc …
Tout cela dans le meme fichier. Et si possible renommer à chaque fois les onglets « analyse1 » et « analyse2 » par le nom de l’entreprise.
Je reste à votre disposition si besoin.
Merci beaucoup pour votre aide
Cordialement,
CGS RH
Salut CGS-RH,
un essai qu'on peut developper aprés
en créant un nouveau fichier:
Sub Extraction_Valeurs1()
Dim i As Long, j As Long, lastrow As Long
Dim entreprise As String
Dim sheetIndex As Integer
Dim NewBook As Workbook, Y As Workbook
sheetIndex = 1
Set NewBook = Workbooks.Add
Set Y = ThisWorkbook
Application.ScreenUpdating = False
With Y.Sheets("infos1")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 5 To lastrow
entreprise = .Cells(i, 2).Value
Y.Sheets("Analyse1").Cells(5, 3).Value = entreprise
For j = 1 To 2
Y.Sheets("Analyse" & j).Copy before:=NewBook.Sheets(sheetIndex)
Sheets(sheetIndex).Name = "Analyse" & j & "_" & entreprise
Application.CutCopyMode = False
sheetIndex = sheetIndex + 1
Next j
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.SetSourceData Source:=Sheets("Analyse1_" & entreprise).Range("B9:C11")
Next i
End With
Application.ScreenUpdating = True
ActiveWorkbook.Close savechanges:=True
End Sub
Dans le même fichier:
Sub Extraction_Valeurs2()
Dim i As Long, j As Long, lastrow As Long
Dim entreprise As String
Application.ScreenUpdating = False
With Sheets("infos1")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 5 To lastrow
entreprise = .Cells(i, 2).Value
Sheets("Analyse1").Cells(5, 3).Value = entreprise
For j = 1 To 2
Sheets("Analyse" & j).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Analyse" & j & "_" & entreprise
Application.CutCopyMode = False
Next j
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.SetSourceData Source:=Sheets("Analyse1_" & entreprise).Range("B9:C11")
Next i
End With
Application.ScreenUpdating = True
End Sub
Bonjour,
merci beaucoup pour votre aide.
En effet, j'ai trouvé la solution.
N'ayant pas eu le temps de cloturer le sujet, je me permets de le faire maintenant.
Merci à vous !
CGS-RH