Imprimer une feuille par dossier sur une autre feuille .

[matmat36]

Bonsoir

J'aimerais avoir votre aide pour finaliser mon petit programme

Je souhaiterais mettre plusieurs feuilles de différents dossiers sur la même feuille .

Private Sub Worksheet_Activate()
Cells.Clear
Sheets("carabine10").Range("A3:l4").Copy
ActiveSheet.Paste Destination:=Worksheets("IMPRIM").Range("A20")
derlig = Sheets("carabine10").Range("A" & Cells.Rows.Count).End(xlUp).Row
lig = 21
For i = 5 To derlig
If Len(Sheets("carabine10").Cells(i, 3).Value) > 0 Then
If Sheets("carabine10").Cells(i, 3).Value <> "NOM" Then
With Worksheets("carabine10")
.Range(.Cells(i, 1), .Cells(i, 12)).Copy
End With
ActiveSheet.Paste Destination:=Worksheets("IMPRIM").Cells(lig, 1)
lig = lig + 1
End If
End If
Next
End Sub

C:\Users\mathieu\Desktop\challenge Guy Soupene\challenge Carabine50m\IMPRIM
C:\Users\mathieu\Desktop\challenge Guy Soupene\challenge Pistolet 10m\IMPRIM
C:\Users\mathieu\Desktop\challenge Guy Soupene\challenge Pistolet 50m\IMPRIM
C:\Users\mathieu\Desktop\challenge Guy Soupene\challenge gros calibre\IMPRIM
C:\Users\mathieu\Desktop\challenge Guy Soupene\challenge Pistolet standard\IMPRIM
C:\Users\mathieu\Desktop\challenge Guy Soupene\challenge Pistolet 25mSport22\IMPRIM

Donc, toutes les feuilles sont identiques , la même macro, mais je voudrais mettre tous les résultats à la suite ,toujours évolutifs sur le même feuille "carabine10"

Est ce possible ?

Merci

 

[matmat36]

Re : Imprimer une feuille par dossier sur une autre feuille .

Re

Je vais vous montrez le résultat final de ce que je souhaiterais en exemple.

Je vous remercie de votre aide

 

[matmat36]

Re : Imprimer une feuille par dossier sur une autre feuille .

Bonjour chers(es) amis(es)

Je relance ma demande .J'ai effectuer une recherche sur l'impression de feuille; mais pas de divers dossiers sur une feuille.

Merci de votre aide

 

[matmat36]

Re : Imprimer une feuille par dossier sur une autre feuille .

Bonjour

J'ai effectué cette macro. Peut on l' améliorer ou bien, existe t il des erreurs ?
J'ai remarqué que dans le classeur carabine50 m , cela ne remets pas la feuille a jour automatiquement pouvez vous me conseiller?

Merci de votre aide.

Mathieu

Sub Macro1()
'
' Macro1 Macro
'

'
ChDir "C:\Users\mathieu\Desktop\challenge Guy Soupene"
Workbooks.Open Filename:= _
"C:\Users\mathieu\Desktop\challenge Guy Soupene\challenge Carabine 50 m.xls"
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
Range("A20:L30").Select
Selection.Copy
ActiveSheet.Paste Destination:=Worksheets("IMPRIM").Range("A20")
derlig = Sheets("carabine10").Range("A" & Cells.Rows.Count).End(xlUp).Row
lig = 21
For i = 5 To derlig
If Len(Sheets("carabine10").Cells(i, 3).Value) > 0 Then
If Sheets("carabine10").Cells(i, 3).Value <> "NOM" Then
With Worksheets("carabine10")
.Range(.Cells(i, 1), .Cells(i, 12)).Copy
End With
ActiveSheet.Paste Destination:=Worksheets("IMPRIM").Cells(lig, 1)
lig = lig + 1
Windows("Copie de challenge carabine10 m.xls").Activate
Range("A39").Select
ActiveSheet.Paste
End Sub