Débutant :copie de valeur et format sur nouveau classeur

[SSD128]

Bonjour à tout le forum,

Après avoir passé de nombreuses heures à parcourir des aides et forums je n'arrive pas à trouver une macro de copie de feuilles sélectionnées vers un classeur dont l'utilisateur choisit le nom:

J'ai un classeur avec des onglets contenant des TCD avec champs mis à jours par macro, et 4 onglets affichant une synthèse de données sélectionnées dans les TCD.

Les 4 premiers onglets de mon classeur comportent donc des tableaux avec des formules de recherche sur les champs des tableaux mis à jour.

Mon problème est je pense simple : Je souhaiterais exporter les 4 onglets dans un nouveau classeur, dont l'utilisateur choisirait le nom par une imput box, en en copiant uniquement les valeurs et formats.

J'ai tenté plusieurs essais et j'en ai honte d'en montrer le code...

Peut être avez vous une macro que je pourrais adapter?

Merci à tous pour votre éventuelle aide!

 

[SSD128]

Re : Débutant :copie de valeur et format sur nouveau classeur

Bon, voici le code me posant problème :

Private Sub Worksheet_Change(ByVal Target As Range)


Dim N As Long

N = Range("b2")
MsgBox Range("a2").Value & " " & Range("b2").Value
Application.ScreenUpdating = False
MsgBox "Traitement de " & Range("a2").Value & " " & Range("b2").Value & " en cours"
Beep

Dim Isect As Range
Set Isect = Application.Intersect(Range("A2"), Target)
If Isect Is Nothing Then Exit Sub
Select Case Target.Value
Case "Janvier"
Call JanvierM
.........
Case "Décembre"
Call DecembreM
End Select

Application.ScreenUpdating = True
Sheets("report 1").Select

MsgBox "Traitement de " & Range("a2").Value & " " & Range("b2").Value & " OK"
'_________________________________
nomfichier = InputBox("nom de fichier")
Set NewBook = Workbooks.Add
With NewBook
.SaveAs Filename:="P:\folder\" & nomfichier & ".xls"
End With

Windows("test.xls").Activate
Sheets(1).Select
Sheets(1).Range("A1:bb60").Select
Selection.Copy
Windows(nomfichier & ".xls").Activate
Sheets(1).Select
Sheets(1).Name = "report1"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Mon classeur nouvellement nommé s'ouvre mais j'obtiens l'arrêt du code en range "A1",erreur 1004 la methode de selecion de la classe range...

A force de bidouiller des bouts de codes d'inspirations diverses, j'ai toujours une erreur qui me suggere que je ne maitrise pas les classeurs/ fueuilles /selection actives...

Toute aide sera vraiment la bienvenue!

Merci d'avance.

 

[Compte Supprimé 979]

Re : Débutant :copie de valeur et format sur nouveau classeur

Salut SSD128,

Dans ton code tu n'es pas obligé de "sélectionner" pour effectuer une action

Essaye :

Windows("test.xls").Activate
Sheets(1).Range("A1:bb60").Copy
Windows(nomfichier & ".xls").Activate
Sheets(1).Name = "report1"
[COLOR=blue][B]With Sheets("report1").Range("A1")
[/B][/COLOR]  .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
  .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
  .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
[COLOR=blue][B]End With[/B][/COLOR]

A+

 

[SSD128]

Re : Débutant :copie de valeur et format sur nouveau classeur




Merci vraiment beaucoup BrunoM45


... et des milliers de fleurs parfumées sur ton chemin!

je vais répéter ce bout de code pour les 3 autres onglets à sauvegarder.

Laurent

 

[SSD128]

Re : Débutant :copie de valeur et format sur nouveau classeur

Hello,

La répétition du code fonctionne bien pour les trois premiers onglets du fichier source, mais plante sur la création du quatrieme (l'indice n'appartient pas à la sélection.

Voici le code répété

nomfichier = InputBox("nom de fichier")
Set NewBook = Workbooks.Add
With NewBook
.SaveAs Filename:=nomfichier & ".xls"
End With

Windows("test.xls").Activate
Sheets(1).Range("A1:bb60").Copy
Windows(nomfichier & ".xls").Activate
Sheets(1).Name = "report1"
With Sheets("report1").Range("A1")
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With

Windows("test.xls").Activate
Sheets(2).Range("A1:bb60").Copy
Windows(nomfichier & ".xls").Activate
Sheets(2).Name = "report2"
With Sheets("report2").Range("A1")
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With


Windows("test.xls").Activate
Sheets(3).Range("A1:bb60").Copy
Windows(nomfichier & ".xls").Activate
Sheets(3).Name = "report3"
With Sheets("report3").Range("A1")
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With

Windows("test.xls").Activate
Sheets(4).Range("A1:bb60").Copy
Windows(nomfichier & ".xls").Activate
Sheets(4).Name = "report4"
With Sheets("report1").Range("A1")
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With


Y aurait il une possibilité de spécifier lors de la création du classeur cible un nombre d'onglet défini à 4 et peut être faire une boucle pour copier coller les 4 onglets sources?
De manière à définir un nombre i dans un compteur qui copie les "i " premiers onglets, ou par nom d'onglet.

Je ne sais si je suis très clair...

Merci d'avance

 

[Compte Supprimé 979]

Re : Débutant :copie de valeur et format sur nouveau classeur

Re,

et des milliers de fleurs parfumées sur ton chemin!

Merci pour ce très joli remerciement boudiste (non !?)

Dans ton code tu t'es trompé sur le nom du sheet 4 pour le collage

With Sheets("report1").Range("A1")

Sinon, pour une répétition utilises plutôt For ... Next

NomFichier = InputBox("nom de fichier")
Set NewBook = Workbooks.Add
With NewBook
  .SaveAs Filename:=NomFichier & ".xls"
End With
For Ind = 1 To 4
  Windows("test.xls").Activate
  Sheets(Ind).Range("A1:BB60").Copy
  Windows(NomFichier & ".xls").Activate
  Sheets(Ind).Name = "report" & Ind
  With Sheets("report" & Ind).Range("A1")
    .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                  SkipBlanks:=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                  SkipBlanks:=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                  xlNone, SkipBlanks:=False, Transpose:=False
  End With
Next Ind

Supprime tout ton code donné ci-avant et remplace le par celui-ci

A+