Macro ou VBA à créer 5 lignes dans l'onglet 2 à partir d'une ligne de l'onglet 1

**cactusben** · 19/10/2017, 18h47

Bonjour à tous,

J'ai une extraction ici exécuté à partir d'un formulaire.

Le hic est que ce formulaire peut avoir plusieurs entrée, donc pour créer mon fichier d'import j'aurais besoins que ces entrées soient individuelles plutot que d'être sur une seule ligne.

voici donc textuellement ce que j'aimerais qu'une macro ou VBA exécute:

Début de la macro à la ligne 2 de la feuille data_exporté.
Une boucle pour vérification de chaque fichier (colonne A)
Si colonne AD contient une donnée copier les colonnes (B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,AC,AD,AI,AN,AO)
et créer une nouvelle ligne dans l’onglet data_macro
Si aucune donnée = skip.
Si colonne AE contient une donnée copier les colonnes (B,C,D,E,F,G,H,I,J,K,L,M,Q,R,S,AC,AE,AJ,AN,AO)
et créer une nouvelle ligne dans l’onglet data_macro
Si aucune donnée = skip.
Si colonne AF contient une donnée copier les colonnes (B,C,D,E,F,G,H,I,J,K,L,M,T,U,V,AC,AF,AK,AN,AO)
et créer une nouvelle ligne dans l’onglet data_macro
Si aucune donnée = skip.
Si colonne AG contient une donnée copier les colonnes (B,C,D,E,F,G,H,I,J,K,L,M,W,X,Y,AC,AG,AL,AN,AO)
et créer une nouvelle ligne dans l’onglet data_macro
Si aucune donnée = skip.
Si colonne AH contient une donnée copier les colonnes (B,C,D,E,F,G,H,I,J,K,L,M,Z,AA,AB,AC,AH,AM,AN,AO)
et créer une nouvelle ligne dans l’onglet data_macro
Si aucune donnée = skip et passe au fichier suivant de la colonne A

Merci beaucoup, si vous avez des commentaires ou questions n'hésitez pas.
basic conversion data DEV.xls

**mjpmjp** · 20/10/2017, 14h57

bonjour,

Début de la macro à la ligne 2 de la feuille data_exporté.

LigneLecture=2 et en fin de traitement (boucle) LigneLecture = LigneLecture + 1
LigneEcriture=1 et en fin de traitement (boucle) LigneEcriture = LigneEcriture + 1

Une boucle pour vérification de chaque fichier (colonne A)...Si aucune donnée = skip et passe au fichier suivant de la colonne A

la feuille data_exporté (colonne A) contient une liste de fichier (excel)(avec "chemin") à ouvrir ou parcourir ?

Si colonne "xx" contient une donnée copier les colonnes "xx"

IF "colonne AD contient une donnée" OR "colonne AE contient une donnée" OR... THEN copier (B,C,D,E,F,G,H,I,J,K,L,M) et (AN,AO)
....IF "colonne AD contient une donnée" THEN copier (N,O,P,AC,AD,AI)
....IF "colonne AE contient une donnée" THEN copier (Q,R,S,AC,AE,AJ)
LigneEcriture = LigneEcriture + 1
END IF
LigneLecture = LigneLecture + 1

@+JP

**BENNASR** · 20/10/2017, 15h46

Bonsoir
y ' a pas mal de discussion pareilles dans ce site

dont :

https://www.developpez.net/forums/d1...glet-classeur/

voila début de réponse

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
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
Sub CollecteInfo()
Dim i As Long
Dim j As Integer
Dim w As Worksheet
Dim a As Long
Application.ScreenUpdating = False
'commencer par néttoyer fiche RECAP qui contient 20 colonnes
With Sheets("data_macro")
a = .Range("A" & Rows.Count).End(xlUp).Row
If .Range("A2") <> "" Then
.Range("A2:T" & a).Select
 Selection.ClearContents
 End If
 End With
 '************************
 j = 2
For Each w In ThisWorkbook.Worksheets
    If w.Name <> "data_macro" Then
        For i = 2 To w.[A65000].End(xlUp).Row
        If w.Cells(i, 30) <> "" Then
        Sheets("data_macro").Cells(j, 1) = w.Cells(i, 2)
        Sheets("data_macro").Cells(j, 2) = w.Cells(i, 3)
        Sheets("data_macro").Cells(j, 3) = w.Cells(i, 4)
        Sheets("data_macro").Cells(j, 4) = w.Cells(i, 5)
        'faire même chose pour le reste à savoir : ,F,G,H,I,J,K,L,M,N,O,P,AC,AD,AI,AN,AO
        '
        '
        '
        End If
        If w.Cells(i, 31) <> "" Then
        Sheets("data_macro").Cells(j, 1) = w.Cells(i, 2)
        Sheets("data_macro").Cells(j, 2) = w.Cells(i, 3)
        Sheets("data_macro").Cells(j, 3) = w.Cells(i, 4)
        Sheets("data_macro").Cells(j, 4) = w.Cells(i, 5)
        '
        '
        '
        '
 
 
 
        ' meme chose pour le ligne 3 , la ligne 4 et la ligne 5
        j = j + 1
        End If
        Next i
    End If
Next w
Application.ScreenUpdating = True
End Sub

**cactusben** · 20/10/2017, 15h50

Bonjour,

Je ne suis pas sur de bien comprendre le tout.
voir mes commentaires ici-bas

Merci beaucoup.

Envoyé par mjpmjp

bonjour,

LigneLecture=2 et en fin de traitement (boucle) LigneLecture = LigneLecture + 1
LigneEcriture=1 et en fin de traitement (boucle) LigneEcriture = LigneEcriture + 1

la feuille data_exporté (colonne A) contient une liste de fichier (excel)(avec "chemin") à ouvrir ou parcourir ?
Cette liste ne contient pas de lien vers les fichiers

IF "colonne AD contient une donnée" OR "colonne AE contient une donnée" OR... THEN copier (B,C,D,E,F,G,H,I,J,K,L,M) et (AN,AO)
....IF "colonne AD contient une donnée" THEN copier (N,O,P,AC,AD,AI)
....IF "colonne AE contient une donnée" THEN copier (Q,R,S,AC,AE,AJ)
LigneEcriture = LigneEcriture + 1
END IF
LigneLecture = LigneLecture + 1
À quel moment dans le code il copie une ligne pour la mettre dans la feuille "data_macro" ?

En me basant sur ce qui est écrit ici je n'arrive pas a faire fonctionner cette macro.
Serait il possible de mettre le code complet ou partiellement complété?
J'ai fais suivre une pièce jointe au besoin. merci.

@+JP

**cactusben** · 20/10/2017, 15h53

Merci je test et vous reviens.

Envoyé par BENNASR

Bonsoir
y ' a pas mal de discussion pareilles dans ce site

dont :
voila début de réponse

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
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
Sub CollecteInfo()
Dim i As Long
Dim j As Integer
Dim w As Worksheet
Dim a As Long
Application.ScreenUpdating = False
'commencer par néttoyer fiche RECAP qui contient 20 colonnes
With Sheets("data_macro")
a = .Range("A" & Rows.Count).End(xlUp).Row
If .Range("A2") <> "" Then
.Range("A2:T" & a).Select
 Selection.ClearContents
 End If
 End With
 '************************
 j = 2
For Each w In ThisWorkbook.Worksheets
    If w.Name <> "data_macro" Then
        For i = 2 To w.[A65000].End(xlUp).Row
        If w.Cells(i, 30) <> "" Then
        Sheets("data_macro").Cells(j, 1) = w.Cells(i, 2)
        Sheets("data_macro").Cells(j, 2) = w.Cells(i, 3)
        Sheets("data_macro").Cells(j, 3) = w.Cells(i, 4)
        Sheets("data_macro").Cells(j, 4) = w.Cells(i, 5)
        'faire même chose pour le reste à savoir : ,F,G,H,I,J,K,L,M,N,O,P,AC,AD,AI,AN,AO
        '
        '
        '
        End If
        If w.Cells(i, 31) <> "" Then
        Sheets("data_macro").Cells(j, 1) = w.Cells(i, 2)
        Sheets("data_macro").Cells(j, 2) = w.Cells(i, 3)
        Sheets("data_macro").Cells(j, 3) = w.Cells(i, 4)
        Sheets("data_macro").Cells(j, 4) = w.Cells(i, 5)
        '
        '
        '
        '
 
 
 
        ' meme chose pour le ligne 3 , la ligne 4 et la ligne 5
        j = j + 1
        End If
        Next i
    End If
Next w
Application.ScreenUpdating = True
End Sub

**mjpmjp** · 20/10/2017, 16h16

bonjour,
BENNASR que je salut au passage

, t' as fourni un début de code

la ligne :

Code :

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

Sheets("data_macro").Cells(j, 1) = w.Cells(i, 2)

copie la cellule B ligne i de l'onglet w
dans l'onglet data_macro , cellule A ligne j

la condition est : If w.Cells(i, 30) <> "" Then (....IF "colonne AD contient une donnée" THEN copier )
si la cellule AD ligne i de l'onglet w "contient" quelque chose alors....

mon schéma copie les cellules communes si AD,AE ou AH entre dans la condition
puis, copie les cellules spécifiques à AD si AD entre dans la condition...

@+JP

**cactusben** · 20/10/2017, 18h45

Merci à vous deux ca marche nickel!

Macro ou VBA à créer 5 lignes dans l'onglet 2 à partir d'une ligne de l'onglet 1 [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager