Création Macro de copie de ligne dans une autre feuille

[joss71]

Bonjour à tous,

Je suis nouveau et je voudrais créé une macro qui copie certaines lignes d'une feuille de base "Base" dans une feuille "JC1" et "JC2" et ainsi de suite

Voir Fichier d'exemple joint

D'avance MERCI

 

[joss71]

Re : Création Macro de copie de ligne dans une autre feuille

Re-Bonjour à tous,

Je suis nouveau et je voudrais créé une macro qui copie certaines lignes d'une feuille de base appelée "Base" dans des feuilles "JC1" et "JC2" et ainsi de suite.

Voir Fichier d'exemple joint (Attention fichier changé- Ajout d'une colonne avec des cellules "-" pour la séparation )

D'avance MERCI

 

[porcinet82]

Re : Création Macro de copie de ligne dans une autre feuille

Salut,

En supposant que tes feuilles contenant le nom des individus ne soient pas deja présentent dans le classeur, je te propose le code suivant :

Sub test()
Dim i As Integer
With Sheets("Base")
    For i = 2 To .Range("A65536").End(xlUp).Row
        lig1 = .Cells(i, 1).Row
        Do While .Cells(i, 1).Value = .Cells(i + 1, 1).Value
            lig2 = .Cells(i, 1).Row
            i = i + 1
        Loop
        Sheets.Add
        ActiveSheet.Name = .Cells(lig1, 1).Value
        .Range(.Cells(lig1, 1), .Cells(lig2, .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A2")
        .Range(.Cells(1, 1), .Cells(1, .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A1")
    Next i
End With
End Sub

@+

 

[fanfan38]

Re : Création Macro de copie de ligne dans une autre feuille

Bonjour
et voilà:
Sub Macro1()
Sheets("JC1").Select
Range("a2:bv65000").ClearContents
Sheets("JC2").Select
Range("a2:bv65000").ClearContents
Sheets("Base").Select
derligbase = Sheets("Base").Range("a" & Cells.Rows.Count).End(xlUp).Row
derligjc1 = 2
derligjc2 = 2
For lig = 2 To derligbase
Sheets("Base").Cells(lig, 1).EntireRow.Select
Selection.Copy
Select Case Cells(lig, 1).Value
Case Is = "JC1"
Sheets("JC1").Select
Sheets("JC1").Cells(derligjc1, 1).Select
ActiveSheet.Paste
derligjc1 = derligjc1 + 1
Case Is = "JC2"
Sheets("JC2").Select
Sheets("JC2").Cells(derligjc2, 1).Select
ActiveSheet.Paste
derligjc2 = derligjc2 + 1
End Select
Sheets("Base").Select
Sheets("Base").Cells(lig, 1).Select
Next lig
End Sub

A+ François

 

[joss71]

Re : Création Macro de copie de ligne dans une autre feuille

Salut,

En supposant que tes feuilles contenant le nom des individus ne soient pas deja présentent dans le classeur, je te propose le code suivant :

Sub test()
Dim i As Integer
With Sheets("Base")
    For i = 2 To .Range("A65536").End(xlUp).Row
        lig1 = .Cells(i, 1).Row
        Do While .Cells(i, 1).Value = .Cells(i + 1, 1).Value
            lig2 = .Cells(i, 1).Row
            i = i + 1
        Loop
        Sheets.Add
        ActiveSheet.Name = .Cells(lig1, 1).Value
        .Range(.Cells(lig1, 1), .Cells(lig2, .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A2")
        .Range(.Cells(1, 1), .Cells(1, .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A1")
    Next i
End With
End Sub

@+

Merci Porcinet82

Je l'ai remis à ma sauce et c'est NICKEL
Merveilleux cadeau en cette fin d'année

BONNES FETES A VOUS TOUS
et encore un grand MERCI

Longue vie à ce forum

JOSS71

 

[joss71]

Re : Création Macro de copie de ligne dans une autre feuille

Salut,

En supposant que tes feuilles contenant le nom des individus ne soient pas deja présentent dans le classeur, je te propose le code suivant :

Sub test()
Dim i As Integer
With Sheets("Base")
    For i = 2 To .Range("A65536").End(xlUp).Row
        lig1 = .Cells(i, 1).Row
        Do While .Cells(i, 1).Value = .Cells(i + 1, 1).Value
            lig2 = .Cells(i, 1).Row
            i = i + 1
        Loop
        Sheets.Add
        ActiveSheet.Name = .Cells(lig1, 1).Value
        .Range(.Cells(lig1, 1), .Cells(lig2, .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A2")
        .Range(.Cells(1, 1), .Cells(1, .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A1")
    Next i
End With
End Sub

@+

Salut porcinet82,

Juste un petit problème (important quand même) après vérif, la macro ne copie pas la dernière ligne de l'appareil sélectionné
Bizarre !!

@+
et encore MERCI de ton aide

Joss71🙁)

 

[porcinet82]

Re : Création Macro de copie de ligne dans une autre feuille

Salut,

il te suffit de modifier légèrement le code comme ceci :

.Range(.Cells(lig1, 1), .Cells(lig2 [COLOR=blue][B]+ 1[/B][/COLOR], .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A2")

@+

 

[joss71]

Re : Création Macro de copie de ligne dans une autre feuille

Salut,

il te suffit de modifier légèrement le code comme ceci :

.Range(.Cells(lig1, 1), .Cells(lig2 [COLOR=blue][B]+ 1[/B][/COLOR], .Range("IV1").End(xlToLeft).Column)).Copy Destination:=Worksheets(ActiveSheet.Name).Range("A2")

@+

Test effectué TIP TOP
Efficace le petit porcinet82

Encore 1000 MERCI et
Bonnes Fêtes de fin d'année

Salutations
Joss71