Copier partiellement une seule feuille d'un workbook [Fermé]

Signaler
Messages postés
7
Date d'inscription
mardi 8 juillet 2014
Statut
Membre
Dernière intervention
10 juillet 2014
-
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
-
Bonjour,

J'ai cherché sur le forum mais aucune discussion traite exactement de ce problème.
J'ai le code ci-dessous qui marche très bien pour copier une feuille entière seulement de mon workbook.

J'aimerais ne copier qu'une partie, à savoir de la ligne 2 à la ligne 998, et que les données soient copiées dans la zone identique
J'ai essayé de mettre Activesheet.Range("A2:AM998").Copy plutôt que Activesheet.Copy mais dans ce cas, bizarrement, le programme me copie la totalité du workbook avec toutes les feuilles, alors que ça devrait marcher...

Auriez-vous des idées pour corriger celà ?
Merci par avance pour votre aide et votre temps...


Public Sub EXPORT()
Application.DisplayAlerts = False
    Dim week As Currency
    Dim nom As String
    week = ActiveSheet.Range("A1")
    nom = ActiveSheet.Range("J1")
    ActiveSheet.Copy
    ChDir "F:\Heestership\_Repertoire Societe\WEEKLY\WEEK" & week
    With ActiveWorkbook
        .SaveAs Filename:=nom, FileFormat:=xlNormal
    End With
MsgBox "FICHIER WEEKLY SAUVEGARDE AVEC SUCCES"
End Sub

4 réponses

Messages postés
7365
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
6 mai 2021
632
Bonjour,

As-tu essayé de te servir de l'enregistreur de macro?

 Range("A2:AM998").Select
    Selection.Copy

Messages postés
7
Date d'inscription
mardi 8 juillet 2014
Statut
Membre
Dernière intervention
10 juillet 2014

Bonjour,

Merci pour cette suggestion, je viens d'essayer, malheureusement le code ci-dessous copie toujours la totalité du workbook (il ajoute même les Macros et clickbuttons dont je n'ai aucunement besoin...)

Et pourtant ce qui est fou c'est que je vois bien excel en train de selectionner la zone (qui devient grisée pendant la procédure).

Je ne sais plus quoi essayer..........


Sub EXPORT()
Application.DisplayAlerts = False
Dim week As Currency
Dim nom As String
week = ActiveSheet.Range("A1")
nom = ActiveSheet.Range("J1")
Range("A2:AM998").Select
Selection.Copy
ChDir "F:\Heestership\_Repertoire Societe\WEEKLY\WEEK" & week
With ActiveWorkbook
.SaveAs Filename:=nom, FileFormat:=xlNormal
.Close
End With
MsgBox "FICHIER WEEKLY SAUVEGARDE AVEC SUCCES"
Application.DisplayAlerts = True
End Sub
Messages postés
7365
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
6 mai 2021
632
C'est normal tu n'indiques pas où tu veux le copier. Fait toute l'opération avec l'enregistreur
Messages postés
7
Date d'inscription
mardi 8 juillet 2014
Statut
Membre
Dernière intervention
10 juillet 2014

En enregistrant toute la procédure jusqu'à enregistrer le nouveau fichier et le fermer, il ne m'enregistre que les deux lignes de codes que tu m'as donné, rien de plus...

Bref, du coup j'ai codé un petit sous-programme qui me copie la partie que je veux dans un nouvel onglet du workbook, puis j'enregistre avec succès la totalité de cet onglet...

C'est vraiment moche, je l'avoue, mais ça marche parfaitement, même si il rame un peu pour copier les 998 lignes et que ça serait surement plus rapide d'utiliser la fonction selection.copy... Mais ça a le mérite de répondre à mon besoin....

Si tu ou quelqu'un d'autre à la solution, je modifierais le code


Sub EXPORT()
Application.DisplayAlerts = False
Dim week As Currency
Dim nom As String
week = ActiveSheet.Range("A1")
nom = ActiveSheet.Range("J1")
Call COPYWKS
Sheets("WEEKLY_").Copy
ChDir "F:\Heestership\_Repertoire Societe\WEEKLY\WEEK" & week
With ActiveWorkbook
.SaveAs Filename:=nom, FileFormat:=xlNormal
.Close
End With
MsgBox "FICHIER WEEKLY SAUVEGARDE AVEC SUCCES"
Application.DisplayAlerts = True
End Sub

Sub COPYWKS()
Dim cpy(999, 40)
Dim i As Currency
Dim j As Currency
For i = 2 To 998
For j = 1 To 39
cpy(i, j) = Sheets("WEEKLY").Cells(i, j)
Next j
Next i
For i = 2 To 998
For j = 1 To 39
Sheets("WEEKLY_").Cells(i, j) = cpy(i, j)
Next j
Next i

End Sub
Messages postés
12251
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2021
2 606
Bonjour,

Il y a plus simple que deux double boucles :
Sub COPYWKS()
Dim cpy(999, 40)
cpy = Sheets("WEEKLY").Range("A2:AM998")
Sheets("WEEKLY_").Range("A2").Resize(998, 39) = cpy
End Sub