Discussion :

[Big75]

Bonjour à tous,

Je viens chercher de l'aide de votre côté, étant donné mes nombreuses heures de recherches sans succès.
Je vous explique l'objectif de ma macro :
Je pars d'une feuille "base", sur laquelle je souhaite copier les cellules des colonnes A, B, C, et D si les cellules de la colonne J sont remplis par "AB". Je précise que là base finale sera sur 1000 lignes, mais que les résultats de la colonne J ne seront pas toujours les mêmes.
Ensuite, je dois coller ces cellules sur la feuilles "synthèse", à la suite. Mais c'est ici que se pose mon problème. Je souhaite ne coller que les 4 premières cellules de la ligne, étant donné que dans le fichier final, les cellules suivantes de la feuille synthèse seront remplies.

Voici donc le code que j'ai déjà développé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Macro1()
 
Dim Cellule As Range
 
Sheets("Base").Select
For Each Cellule In Range("J3:J" & Range("J1003").End(3).Row)
    If Cellule.Value = "AB" Then
 
        With Sheets("Synthèse")
        Rows(Cellule.Row).Copy .Rows(.Range("A19").End(3).Row + 1)
        End With
 
    End If
Next Cellule
 
End Sub

Cependant, ce code execute bien la condition, mais colle la ligne entière (ce qui est normal étant donné l'utilisation des rows vous me direz). Cependant je ne parviens pas à réécrire ce code... Je suis débutant en VBA et je pense que j'atteins mes limites.

Merci d'avance

[Theze]

Bonjour,

De cette façon peut être :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Range("A" & Cellule.Row & ":D" & Cellule.Row).Copy .Rows(.Range("A19").End(3).Row + 1)

[Big75]

Bonjour Theze,

Merci pour cette réponse. Le code est amélioré car contrairement au mien, le votre permet bien de copier les 4 premières cellules.
Cependant, lors du collage, les 4 cellules se collent à la suite jusqu'au bout de la ligne.

Aurais-tu une solution pour "baliser" les colonnes de collage?

Merci beaucoup!

[Philippe Tulliez]

Bonjour,
Autre approche avec la méthode AdvancedFilter (Filtre avancé)
Dans cet exemple, on exporte les cellules des colonnes $A:$D de la feuille nommée [db] vers la feuille nommée [Synthèse] si le contenu de la colonne E est égal à "A"
Attention : Pour que cela fonctionne, il faut impérativement que les en-têtes de colonne de la feuille db aient la même orthographe que celles de la feuille Synthèse

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub T()
 ' Déclaration des variables objets
 Dim areaData As Range, areaExport As Range, areaCriteria As Range
 ' Attribution des références aux zones Data et Export
 With ThisWorkbook
  Set areaData = .Worksheets("db").Range("A1").CurrentRegion
  Set areaExport = .Worksheets("Synthèse").Range("A1:D1")
 End With
 ' Attribution de la référence de la zone des critères
 With areaData
  Set areaCriteria = .Offset(columnoffset:=.Columns.Count + 1).Resize(2, 1)
 End With
 ' Ecriture des critères
 With areaCriteria
  .Cells(1, 1) = "_fn_": .Cells(2, 1) = "=E2=""A"""
 End With
 ' Exportation des données suivant critères
 areaData.AdvancedFilter xlFilterCopy, areaCriteria, areaExport
 areaCriteria.Clear ' Supprime les critères
 Set areaData = Nothing: Set areaExport = Nothing: Set areaCriteria = Nothing
End Sub

A lire éventuellement Les filtres avancés ou élaborés dans Excel

[Big75]

Bonjour Philippe,

Merci pour cette réponse.
J'ai tenté de l'adapter à mon tableur mais sans succès. Le critère ne semble pas s'appliquer...

[Theze]

Bonsoir,

Cependant, lors du collage, les 4 cellules se collent à la suite jusqu'au bout de la ligne.

C'est normale, puisque tu veux le copier sur toute la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
.Rows(.Range("A19").End(3).Row + 1)

Alors de cette façon :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Range("A" & Cellule.Row & ":D" & Cellule.Row).Copy .Range("A19").End(3).Offset(1)