Discussion :

[La Zélie]

Bonsoir le forum,

Je veux copier les données d'une feuille "Résultat" vers une feuille "Archive".

Je me suis inspirée d'un exemple trouvé sur le forum par String

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test()
Dim Shc As Worksheet, Shs1 As Worksheet, Shs2 As Worksheet
 
Set Shc = Sheets("feuille cible")
Set Shs1 = Sheets("feuille source 1")
Set Shs2 = Sheets("feuille source 2")
 
Shs1.Range("A2:E" & Shs1.Range("E65535").End(xlUp).Row).Copy Shc.Range("A65535").End(xlUp)(2)
Shs2.Range("A2:E" & Shs2.Range("E65535").End(xlUp).Row).Copy Shc.Range("A65535").End(xlUp)(2)
 
End Sub

A ce code j'ai ajouté dans la feuille cible la création d'une feuille, un nouveau formatage des données et le nom de l'onglet.

Ma macro s'arrête sur la ligne indiquée ci-dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub  Archivage()
'Je démarre ma macro depuis le dossier ouvert « Traitement » qui possède une feuille « Résultat »
'C’est cette feuille « Résultat » que je veux archiver.
 
Workbooks.Open Filename:="C:\Dossier\Archive2008.xls"
Sheets.Add
    Range("A1").Select
 
Dim Shc As Worksheet, Shsl As Worksheet
 
Set Shc = Sheets("Archive2008.xls")
Set Shs1= Sheets("Résultat") '<-- erreur sur cette ligne
 
Shs1.Range("A1:V1")(Shs1.Range("A65535").End(xlUp).Row).Copy
Shc.Range("A65535").End (xlUp)
 
Cells.EntireColumn.AutoFit
    With Selection
        .HorizontalAlignment = xlLeft
        .ReadingOrder = xlContext
    End With
    Range("A1").Select
    Dim nom As String
    nom = ActiveCell.Value
    ActiveSheet.Name = Cells(2, 21).Value
    ActiveWorkbook.Save
    ActiveWindow.Close
 
End Sub

Je dois pas faire quelque chose mais quoi?

Merci de me répondre et bonne nuit

Je reviendrais demain comme pratiquement tous les jours

[fring]

Bonjour,

Cela coince parce que quand tu ne précises le classeur, il prend en compte le classeur actif. Le classeur actif à ce moment là de ton code est le classeur "Archivage" et dans ce classeur il ne trouve pas la feuille "Résultat". Avant de te montrer comment faire je vais d'abord passer le reste de ton code en revue parce que la suite du code t'aurait provoqué de jolis bugs aussi...

• Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  Shs1.Range("A1:V1")(Shs1.Range("A65535").End(xlUp).Row).Copy

  La syntaxe n'est pas correcte, si tu veux copier la plage de la cellule A1 à la dernière cellule de la colonne V, cela s'écrit comme ceci :
  

  Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  Shs1.Range("A1:V" & Shs1.Range("V65535").End(xlUp).Row).Copy

• Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  1
  2
  Shs1.Range("A1:V" & Shs1.Range("V65535").End(xlUp).Row).Copy
  Shc.Range("A65535").End (xlUp)

  Si tu écris cette syntaxe sur 2 lignes (tu peux voir que dans l'exemple de String... la syntaxe est écrite sur une seule ligne) il faut ajouter .Paste (ou PasteSpecial) sur la seconde ligne. Tu peux donc écrire ceci :
  

  Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  Shs1.Range("A1:V" & Shs1.Range("V65535").End(xlUp).Row).Copy Shc.Range("A65535").End(xlUp)

• Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  Shc.Range("A65535").End(xlUp)

  Là tu vas écraser la dernière ligne occupée de ta colonne A, pour démarrer la copie à la première ligne vide, il faut ajouter (2) qui correspond à Offset(1, 0)
  

  Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  Shc.Range("A65535").End(xlUp)(2)

• Si c'est pour copier toutes les cellules d'une feuille dans une nouvelle feuille, autant copier la feuille directement
  .
• Attention, lorsque tu utilises le contenu d'une cellule pour renommer une feuille, il faut être certain que cette cellule ne contient pas des caractères non autorisés du style / ou \ ou * etc...

Je te propose donc d'essayer ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Archivage()
Dim SHsource As Worksheet, WBcible As Workbook
 
'feuille source
Set SHsource = ThisWorkbook.Sheets("Résultat")
 
'classeur cible
Set WBcible = Workbooks.Open(Filename:="C:\Dossier\Archive2008.xls")
 
'copie de la feuille source à la fin du classeur cible
SHsource.Copy After:=WBcible.Sheets(Sheets.Count)
 
'renommer la feuille cible
WBcible.Sheets(Sheets.Count).Name = WBcible.Sheets(Sheets.Count).Cells(2, 21)
 
'fermeture et sauvegarde du classeur cible
WBcible.Close True
 
'libération de la mémoire
Set SHsource = Nothing
Set WBcible = Nothing
End Sub

[La Zélie]

Bonjour et merci Fring pour ta réponse

Je vais corriger et je reviens pour dire mon résultat.

A+