Résolu Créer un recap

cissou9980

Nouveau membre
Bonjour,

J'ai un fichier XLS avec plusieurs feuilles 1 onglet par utilisateur. L'objectif et de créer un nouveau classeur indépendant qui regroupe la totalité des données de mes utilisateurs.
J'ai réussi avec cette macro à créer une nouvelle feuille mais je voudrai que cette feuille ne soit pas dans le même classeur mais dans un nouveau qui s'appellerai "Recap *datedujour"

Merci de votre aide.
Voici la macro utilisée :

Code:
Sub Recap()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Recap"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
 

drul

Obscur pro du hardware
Staff
Salut, quelque chose comme ça ?
Code:
Sub Recap()
Dim sh As Worksheet
Dim srcWb As Workbook
Dim newWb As Workbook
Dim newWbname As String

Set srcWb = ThisWorkbook
Set newWb = Workbooks.Add
newWbname = "Recap " & Date
srcWb.Sheets(1).Range("A1").EntireRow.Copy Destination:=newWb.Sheets(1).Range("A1").EntireRow

For Each sh In srcWb.Sheets
    sh.Range("A1").CurrentRegion.Offset(1, 0).Resize(sh.Range("A1").CurrentRegion.Rows.Count - 1).Copy Destination:=newWb.Sheets(1).Range("A65536").End(xlUp)(2)
Next
newWb.SaveAs (newWbname)
End Sub

N.B. j'ai un peu compacter en enlevant les xxx. SELECT puis SELECTION.yyyy qui ne serve à rien...
 

cissou9980

Nouveau membre
Merci beaucoup, cela fonctionne à peu près ...

En fait j'ai un message qui me dit :
erreur d'exécution
erreur définie par l'application ou par l'objet

De plus finalement, le nouveau fichier ne prend pas le nom de récap ni même la date ?

Mais sur le principe on est presque là où je veux aller !!!

Merci déjà pour ce point là !!! :bounce:
 

drul

Obscur pro du hardware
Staff
Faut utiliser les points d'arrêt et des msgbox pour voir ce qui coince ...
 

cissou9980

Nouveau membre


 

cissou9980

Nouveau membre
c'est sur cette ligne que ça ne va pas ..

sh.Range("A1").CurrentRegion.Offset(1, 0).Resize(sh.Range("A1").CurrentRegion.Rows.Count - 1).Copy Destination:=newWb.Sheets(1).Range("A65536").End(xlUp)(2)


.... Désolée, je ne suis pas vraiment super douée :)
 

drul

Obscur pro du hardware
Staff
Meilleure réponse
Essaye de modifier la boucle for each de la manière suivante:
Code:
For Each sh In srcWb.Sheets
    If sh.Range("A1").CurrentRegion.Rows.Count > 1 Then
        sh.Range("A1").CurrentRegion.Offset(1, 0).Resize(sh.Range("A1").CurrentRegion.Rows.Count - 1).Copy Destination:=newWb.Sheets(1).Range("A65536").End(xlUp)(2)
    End If
Next
La source de l'erreur est probablement un resize(x) avec x < 1 ce qui n'est évidement pas supporté ...
 

cissou9980

Nouveau membre

En fait en me creusant un peu la tête j'ai réussi !!!

:bounce:

Bon si j'ai d'autres questions du genre que je ne réussi pas je saurai te retrouver drul ;)
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 073
Membres
1 586 286
Dernier membre
petitangebleu1977
Partager cette page
Haut