coller feuilles plusiurs classeurs

[tascou]

Bonjour
j'ai un classeurs A qui contient une seul feuille,
j'aime bien copier cette feuilles et la faire coller sur des milliers de page excel qui se trouve dans un meme dossier.
c'est possible? j'ai effectuer des dixaine d'essais VBA mais j'arrive tjr pas à trouver une solution .
Vous pouvier m'aider SVP

 

[Papou-net]

Re : coller feuilles plusiurs classeurs

Bonjour tascou, et bienvenue,

Je ne comprends pas bien ta question, mais s'il s'agit de copier une page dans un nouveau classeur, ce genre d'instruction le fait très bien :

Sheets("Feuil1").Copy

Cette simple ligne créera une copie de ta feuille dans un nouveau classeur et activera ce classeur. Pour recommencer une autre copie, il faudra revenir sur le classeur précédent. La sauvegarde des classeurs créés se fera avec la boîte de dialogue "Enregistrer sous" lors de leur fermeture. Il est possible d'automatiser tout cela, mais il faudrait en savoir un peu plus.

Restant à ton écoute.

Cordialement.

 

[tascou]

Re : coller feuilles plusiurs classeurs

Bonjour et merci pour ton aide
Mon but et
* Copier la page de garde (une page unique qui se trouve sur un classeur nomé A)
* Activer le premier classeurs,
* Coller cette page,
* Enregister,
* Fermer
puis passer à un deuxième classeurs
j'ai des milliers de calsseurs à traiter

j'ai écrit ce petit algo:

Sub test()

Dim wbk As Workbook, awbk As Workbook
Dim wsh As Worksheet
Dim Fich As String
Dim Ligne As Double

Application.ScreenUpdating = False
Set awbk = ThisWorkbook
Set wsh = awbk.Sheets

Fich = Dir("D:\Personnel\Anis\*.xls")
Do While Fich <> ""
With wsh
Ligne = .Range("A65536").End(xlUp).Row + 1
Set wbk = Workbooks.Open("D:\Personnel\Anis\" & Fich)
wbk.Sheets("Feuil1").Range("A7", wbk.Sheets("Feuil1").Range("H65536").End(xlUp)).copy .Cells(Ligne, 1)
wbk.Sheets("Feuil1")
End With
wbk.Close False
Fich = Dir
Set wbk = Nothing
Loop
Set wsh = Nothing
Set awbk = Nothing
Application.ScreenUpdating = True
End Sub

Mais cette algo ne fonctionne pas

 

[Papou-net]

Re : coller feuilles plusiurs classeurs

Bonjour tascou,

C'est avec un peu de retard que je réponds à ta demande, mais ne vaut-il pas mieux tard que jamais ?

Je t'envoie ton code modifié (Lignes en bleu), il ne te reste plus qu'à vérifier les lignes en rouge car je ne vois pas bien où il faut coller les données.

Sub test()

[COLOR="RoyalBlue"][B]Dim Rep[/B][/COLOR]
Dim wbk As Workbook, awbk As Workbook
Dim wsh As Worksheet
Dim Fich As String
Dim Ligne As Double

Application.ScreenUpdating = False
Set awbk = ThisWorkbook
Set wsh = ThisWorkbook.Sheets(1)
[COLOR="RoyalBlue"][B]Rep = "D:\Personnel\Anis\"[/B][/COLOR]

[COLOR="RoyalBlue"][B]Fich = Dir(Rep & "*.xls")[/B][/COLOR]
Do While Fich <> ""
  With wsh
    Ligne = .Range("A65536").End(xlUp).Row + 1
    Set wbk = Workbooks.Open(Rep & Fich)
    [COLOR="Red"][B]wbk.Sheets("Feuil1").Range("A7", wbk.Sheets("Feuil1").Range("H65536").End(xlUp)).Copy.Cells(Ligne, 1)
    wbk.Sheets ("Feuil1")[/B][/COLOR]
  End With
  wbk.Close False
  Fich = Dir
  Set wbk = Nothing
Loop
Set wsh = Nothing
Set awbk = Nothing
Application.ScreenUpdating = True
End Sub

Espérant t'avoir aidé.

Cordialement.