Macro Archivage

wiipower · 2 Décembre 2013

Bonjour

J'ai un macro dans un fichier excel qui me permet d'archiver toutes les lignes 25 à 31 dans un tableau se situant dans une autre feuille et cette macro permet de coller les données à partir de la colonne A et de la dernière ligne remplie

Et j'aimerais adapter cette macro pour copier les lignes 2 à 39 ou plus précisément les cellules de mon tableau A2 à k39 dans un tableau recap dont la colonne A comprend une numérotation(voir fichier joint)

Merci de votre aide

Macro d'origine :

Code:

Sub Archivage()
Dim Source As Range, Dest As Range, Lgn As Range

  '  on travaille à partir de la feuille active
  Set Source = ActiveSheet.Rows("25:31")
  '  pour plus de sécurité, il vaudrait mieux préciser le nom
  '  de la feuille source, donc écrire
  '  Set Source = ThisWorkbook.Worksheets("NomDeLaFeuille").Rows("25:31")

  With ThisWorkbook.Worksheets("Recap")
    Set Dest = .Range("A65536").End(xlUp)
    If Dest.Row > 1 Or Dest <> "" Then Set Dest = Dest.Offset(1, 0)
  End With

  For Each Lgn In Source.Rows
    If Lgn.Cells(1, 1) <> "" Then
      Lgn.Copy
      Dest.PasteSpecial xlPasteValuesAndNumberFormats
      Set Dest = Dest.Offset(1, 0)
    End If
  Next Lgn
  Application.CutCopyMode = False
End Sub

wiipower · 3 Décembre 2013

Re : Macro Archivage

Je pense avoir trouver ma solution

Code:

Sub Archivage2()
Dim Source As Range, Dest As Range, Lgn As Range

  '  on travaille à partir de la feuille active
  
  Set Source = ActiveSheet.Range("a2:k17")
  
  '  pour plus de sécurité, il vaudrait mieux préciser le nom
  '  de la feuille source, donc écrire
  '  Set Source = ThisWorkbook.Worksheets("NomDeLaFeuille").Rows("25:31")

  With ThisWorkbook.Worksheets("Compta Basket")
    Set Dest = .Range("b65536").End(xlUp)
    If Dest.Row > 1 Or Dest <> "" Then Set Dest = Dest.Offset(1, 0)
  End With

  For Each Lgn In Source.Rows
    If Lgn.Cells(1, 1) <> "" Then
      Lgn.Copy
      Dest.PasteSpecial xlPasteValuesAndNumberFormats
      Set Dest = Dest.Offset(1, 0)
    End If
  Next Lgn
  Application.CutCopyMode = False
End Sub

Macro Archivage

wiipower

XLDnaute Nouveau

Pièces jointes

wiipower

XLDnaute Nouveau

Discussions similaires