Macro code article

Version imprimable

18/02/2013, 11h53
zorgon80

1 pièce(s) jointe(s)

Macro code article

bonjour à vous

voici mon probleme

j'ai un fichier excel récupéré de sap et j'aimerai récupérer trois lignes/colones d'informations
le code article ,le poids et la valeur seulement voila le nombre de lignes entre chaque n'est pas identique la colone oui
ces valeurs seront reprises sur une autre feuille fichier
je vous joins un exemple pour que cela soit plus clair ( j'ai stabylé les zonnes voulues
par avance merci pour votre aidre
cordialement
18/02/2013, 12h53
QuestVba

1 pièce(s) jointe(s)

Bonjour

sur ta feuille 2 en a1, tu notes

Code:

=DECALER(Feuil1!$I$3;(LIGNE()-1)*15;)

Cela récupère ton article puisque toujours le même écart
Pour le reste
en b1

Code:

=DECALER(Feuil1!$N$9;(LIGNE()-1)*15;)

en c1

Code:

=DECALER(Feuil1!$T$9;(LIGNE()-1)*15;)
18/02/2013, 13h41
zorgon80

1 pièce(s) jointe(s)

Citation:

Envoyé par QuestVba

Bonjour

sur ta feuille 2 en a1, tu notes

Code:

=DECALER(Feuil1!$I$3;(LIGNE()-1)*15;)

Cela récupère ton article puisque toujours le même écart
Pour le reste
en b1

Code:

=DECALER(Feuil1!$N$9;(LIGNE()-1)*15;)

en c1

Code:

=DECALER(Feuil1!$T$9;(LIGNE()-1)*15;)

bonjour questvba

la formule fonctionne bien mais arrivé à la ligne 54 dans mon fichier d'origine cela ne fonctionne plus

cordialement

Bonjour
Une proposition de macro

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub recuperer()
Dim derligne As Long, i As Long, j As Long
 
    Worksheets("Feuil2").Range("A1").Value = "Article"
    Worksheets("Feuil2").Range("B1").Value = "Poids"
    Worksheets("Feuil2").Range("C1").Value = "Valeur"
 
    With Worksheets("Feuil1")
        derligne = .Range("B" & Rows.Count).End(xlUp).Row
        j = 2
        For i = 2 To derligne
            If .Cells(i, 2).Value = "Article" Then
                Worksheets("Feuil2").Range("A" & j).Value = .Cells(i, 9)
                Worksheets("Feuil2").Range("B" & j).Value = .Cells(i + 6, 14)
                Worksheets("Feuil2").Range("C" & j).Value = .Cells(i + 6, 20)
                j = j + 1
            End If
        Next i
    End With
 
End Sub

Les lignes 4 à 6 peuvent se supprimer si on a écrit manuellement des titres sur la première ligne de la feuille 2.
Cordialement
Claude

Citation:

Envoyé par papouclo

Bonjour
Une proposition de macro

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub recuperer()
Dim derligne As Long, i As Long, j As Long
 
    Worksheets("Feuil2").Range("A1").Value = "Article"
    Worksheets("Feuil2").Range("B1").Value = "Poids"
    Worksheets("Feuil2").Range("C1").Value = "Valeur"
 
    With Worksheets("Feuil1")
        derligne = .Range("B" & Rows.Count).End(xlUp).Row
        j = 2
        For i = 2 To derligne
            If .Cells(i, 2).Value = "Article" Then
                Worksheets("Feuil2").Range("A" & j).Value = .Cells(i, 9)
                Worksheets("Feuil2").Range("B" & j).Value = .Cells(i + 6, 14)
                Worksheets("Feuil2").Range("C" & j).Value = .Cells(i + 6, 20)
                j = j + 1
            End If
        Next i
    End With
 
End Sub

Les lignes 4 à 6 peuvent se supprimer si on a écrit manuellement des titres sur la première ligne de la feuille 2.
Cordialement
Claude

bonjour papouclo

cette macro fonctionne nickel
merci beaucoup pour cette aide cela me fait gagner du temps
cordialement