Macro pour archiver zones discontinues...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais votre aide afin d'écrire une macro. Cette macro devra archiver une zone de données, séparée par quelques colonnes vides, que je ne souhaite par archiver...

VOIR FICHIER

Je vous remercie pour votre aide si précieuse.

Bien amicalement,
Christian

 

[Staple1600]

Re : Macro pour archiver zones discontinues...

Bonjour à tous

Une suggestion en passant
Tu pourrais sauvegarder toutes colonnes
(copie de ta feuille)
puis supprimer dans la copie les colonnes G à L

Ce qui donnerai une macro du genre

Sub Macro1()
Sheets("Feuil1").Copy After:=Sheets(1)
Columns("G:L").Delete Shift:=xlToLeft
End Sub

 

[job75]

Re : Macro pour archiver zones discontinues...

Bonjour Christian, Jean-Marie,

Oui, ou aussi cette macro dans le code de la feuille "Base Plats" :

Private Sub Worksheet_Activate()
Dim P As Range, M As Range
With Feuil1 'CodeName de la feuille source
  Set P = .[E7:AF50]: Set M = .[G:L] 'à adapter au besoin
  M.Columns.Hidden = True
  P.SpecialCells(xlCellTypeVisible).Copy [A3]
  M.Columns.Hidden = False
End With
Columns.AutoFit 'ajustement de la largeur
End Sub

A+

 

[job75]

Re : Macro pour archiver zones discontinues...

Re,

Bah pourquoi faire simple...

Private Sub Worksheet_Activate()
'Feuil1 est le CodeName de la feuille source
Feuil1.[E7:F50,M7:AF50].Copy [A3]
Columns.AutoFit 'ajustement de la largeur
End Sub

A+

 

[Christian0258]

Re : Macro pour archiver zones discontinues...

Re, le forum, Staple1600, job75,

Effectivement, Staple1600, c'est une bonne piste.
Je privilégie la solution de job75.

Merci à vous pour le boulot.

Bien amicalement,
Christian

 

[Christian0258]

Re : Macro pour archiver zones discontinues...

Re, le forum

Staple1600
job75,

Après essai, l'archivage s'effectue...mais ce que je souhaite c'est mettre les données à la suite à chaque archivage...

A vous lire,

Christian

 

[job75]

Re : Macro pour archiver zones discontinues...

Re,

Alors utilise cette macro :

Sub Archivage()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim dercel As Range
Set dercel = Feuil2.Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
With dercel.Parent.Range("A" & dercel.Row + 1)
  Feuil1.[E7:F50,M7:AF50].Copy .Cells
  .Parent.Columns.AutoFit 'ajustement de la largeur
  .Parent.Activate 'facultatif
End With
End Sub

Cette méthode avec Find est la plus sûre pour déterminer la dernière ligne.

A+

 

[Christian0258]

Re : Macro pour archiver zones discontinues...

Re , le forum,

Merci, job75, c'est comme d'hab...parfait.

Bien à toi,
Christian