Copie relative dans une macro

[ANJE ADETILE]

Bonjour

cf. fichier exemple

J'ai des données résultant d'analyses qui sont copiées dans un onglet data1 et dans un onglet data2. J'effectue un filtrage automatique sur ces données et je souhaite établir un rapport situé dans le premier onglet par copie des 20 premières références des onglet data1 et data2.

Mon problème vient du fait que mes données sont variables en nombre de lignes et que je n'arrive pas à faire une copie "relative" des données data1 et 2 résultant du filtre appliqué dans ma macro. J'ai parfois trop de données, parfois pas assez. Je veux limiter le rapport aux 20 1ères lignes de chaque onglet aprés filtrage.

Merci de votre support

ANJE

 

[Robert]

Re : Copie relative dans une macro

Bonjour Anje Adetile, bonjour le forum,

peut-être comme ça :

Sub Macro1()
Dim dat1 As Range 'déclare la variable dat1
Dim dat2 As Range 'déclare la variable dat2
Dim x As Integer 'déclare la variable x
Dim y As Byte 'déclare la variable y
 
'efface les anciennes données de l'onglet "Rapport"
Sheets("Rapport").Rows("5:14").ClearContents
Sheets("Rapport").Rows("17:26").ClearContents
 
Set dat1 = Sheets("data1").Range("A1").CurrentRegion 'définit la plage dat1
Set dat1 = dat1.Offset(1, 0).Resize(dat1.Rows.Count - 1) 'redéfinit la plage dat1 (sans la première ligne)
y = 1 'définit la variable y
For x = 1 To dat1.Rows.Count 'boucle sur toutes les lignes de dat1
    If y > 10 Then Exit For 'si y est supérieur à 10, sort de la boucle
    If dat1.Rows(x).Hidden = False Then 'condition : si la ligne n'est pas masquée
        dat1.Rows(x).Copy Sheets("Rapport").Cells(4 + y, 1) 'copie la ligne dans l'onglet Rapport
        y = y + 1 'redéfinit la variable y
    End If 'fin de la condition
Next x

Set dat2 = Sheets("data2").Range("A1").CurrentRegion 'définit la plage dat2
Set dat2 = dat2.Offset(1, 0).Resize(dat2.Rows.Count - 1) 'redéfinit la plage dat2 (sans la première ligne)
y = 1 'définit la variable y
For x = 1 To dat2.Rows.Count 'boucle sur toutes les lignes de dat2
    If y > 10 Then Exit For 'si y est supérieur à 10, sort de la boucle
    If dat2.Rows(x).Hidden = False Then 'condition : si la ligne n'est pas masquée
        dat2.Rows(x).Copy Sheets("Rapport").Cells(16 + y, 1) 'copie la ligne dans l'onglet Rapport
        y = y + 1 'redéfinit la variable y
    End If 'fin de la condition
Next x
End Sub

Je n'arrive pas non plus à faire plus simple...

 

[Efgé]

Re : Copie relative dans une macro

Bonjour ANJE ADETILE, Bonjour Robert 🙂,
Maintenant que Robert a fait tout le boulot, la mouche du coche se permet une propostion pour raccourcir le nombre de lignes de code (mais pas forcément le traitement).
Ca permet de traiter plus de feuilles.

[COLOR=blue]Sub[/COLOR] Macro1()
[COLOR=blue]Dim[/COLOR] dat1 [COLOR=blue]As[/COLOR] Range[COLOR=green] 'déclare la variable dat1[/COLOR]
[COLOR=blue]Dim[/COLOR] dat2 [COLOR=blue]As[/COLOR] Range[COLOR=green] 'déclare la variable dat2[/COLOR]
[COLOR=blue]Dim[/COLOR] x [COLOR=blue]As Integer[/COLOR][COLOR=green] 'déclare la variable x[/COLOR]
[COLOR=blue]Dim[/COLOR] y [COLOR=blue]As Byte[/COLOR][COLOR=green] 'déclare la variable y[/COLOR]
[COLOR=blue]Dim[/COLOR] z [COLOR=blue]As Integer[/COLOR][COLOR=green] 'déclare la variable z[/COLOR]
[COLOR=green]'efface les anciennes données de l'onglet "Rapport"[/COLOR]
Liste = "data1,data2,"
Sheets("Rapport").Rows("5:14").ClearContents
Sheets("Rapport").Rows("17:26").ClearContents
z = 4
[COLOR=blue]For Each[/COLOR] Cht [COLOR=blue]In[/COLOR] ActiveWorkbook.Worksheets
    [COLOR=blue]If[/COLOR] InStr(Liste, Cht.Name & ",") <> 0 [COLOR=blue]Then[/COLOR]
        [COLOR=blue]Set[/COLOR] dat1 = Sheets("data1").Range("A1").CurrentRegion[COLOR=green] 'définit la plage dat1[/COLOR]
        [COLOR=blue]Set[/COLOR] dat1 = dat1.Offset(1, 0).Resize(dat1.Rows.Count - 1)[COLOR=green] 'redéfinit la plage dat1 (sans la première ligne)[/COLOR]
        y = 1[COLOR=green] 'définit la variable y[/COLOR]
        [COLOR=blue]For[/COLOR] x = 1 [COLOR=blue]To[/COLOR] dat1.Rows.Count[COLOR=green] 'boucle sur toutes les lignes de dat1[/COLOR]
            [COLOR=blue]If[/COLOR] y > 10 [COLOR=blue]Then Exit For[/COLOR][COLOR=green] 'si y est supérieur à 10, sort de la boucle[/COLOR]
            [COLOR=blue]If[/COLOR] dat1.Rows(x).Hidden = [COLOR=blue]False Then[/COLOR][COLOR=green] 'condition : si la ligne n'est pas masquée[/COLOR]
                dat1.Rows(x).Copy Sheets("Rapport").Cells(z + y, 1)[COLOR=green] 'copie la ligne dans l'onglet Rapport[/COLOR]
                y = y + 1[COLOR=green] 'redéfinit la variable y[/COLOR]
            [COLOR=blue]End If[/COLOR][COLOR=green] 'fin de la condition[/COLOR]
        [COLOR=blue]Next[/COLOR] x
        z = z + 12
    [COLOR=blue]End If[/COLOR]
[COLOR=blue]Next[/COLOR] Cht
[COLOR=blue]End Sub[/COLOR]

Cordialement

 

[Efgé]

Re : Copie relative dans une macro

Re 😱
Remplacer

Set dat1 = Sheets("data1").Range("A1").CurrentRegion

Par

Set dat1 = Cht.Range("A1").CurrentRegion

Cordialement

 

[ANJE ADETILE]

Re : Copie relative dans une macro

Merci à Robert et Efgé pour ce travail d'équipe. J'ai repris le code et adapté à ma version live définitive avec quelques ajstements et le résultat est là, cela fonctionne.

Merci pour la leçon et pour la réactivité du Forum.

ANJE