Copier des cellules Excel vers une nouvelle feuille Excel

Bonjour A TOUS

Je cherche à pouvoir copier des cellules vers une nouvelle feuille EXCEL appelée (t100) selon des critères spécifiques

Colonne 1: Seulement les données F

Colonne 4: Faire un tri du plus petit au plus grand

Le but est de retrouver l'ensemble des données selon les critères spécifiques cités plus haut

Ci-joint un document qui reprends les explications ci-dessus

Je vous remercie d'avance pour votre aide ou tout support qui permettrait d'avoir une solution

Cdt

BOUBOU

32exe2.xlsm (41.38 Ko)

Bonsoir,

Je pense que la macro suivante pourra répondre à tes attentes (si j'ai bien compris ta demande) :

Sub Test()
i = 2
j = 3
While Feuil2.Range("A" & i) <> ""
If Feuil2.Range("A" & i) = "FF" Then
Feuil1.Range("C" & j) = Feuil2.Range("A" & i)
Feuil1.Range("D" & j) = Feuil2.Range("B" & i)
Feuil1.Range("E" & j) = Feuil2.Range("C" & i)
Feuil1.Range("F" & j) = Feuil2.Range("D" & i)
Feuil1.Range("G" & j) = Feuil2.Range("E" & i)
Feuil1.Range("H" & j) = Feuil2.Range("F" & i)
Feuil1.Range("I" & j) = Feuil2.Range("G" & i)
j = j + 1
End If
i = i + 1
Wend
End Sub

Bonne soirée

MERCI BEAUCOUP SHARNEY

Je vais essayer mais aurais tu pu l'écrire sur le doc Excel joint si tu as le temps bien sur

Car j'aurai je pense j'aurais beaucoup de mal à l'adapter au doc

Je veux dire si je créer un bouton et fais un copier coller de ton code "sa marchera"? si oui c'est génial

Je ne peux pas le faire car ton fichier a un système qui m'empêche de l'enregistrer. C'est pour cela que je t'ai mis le code directement ici.

Mais normalement tu n'as qu'à créer un bouton et copier-coller mon code pour que cela fonctionne.

SUPER SA MARCHE MERCI BEAUCOUP

BONNE SOIREE

Tant mieux !

Bonne soirée

Bonjour, une alternative.

Sub rcp()
    Application.DisplayAlerts = False
    a = Feuil2.UsedRange
    n = 0

    ReDim b(UBound(a))
    For i = 2 To UBound(a)
        If a(i, 1) = "FF" Then
            For j = 1 To 7
                If IsEmpty(b(n)) Then
                    b(n) = a(i, j)
                Else
                    b(n) = b(n) & Chr(32) & a(i, j)
                End If
            Next
            n = n + 1
        End If
    Next

    With Feuil1
        .Cells(2, 3) = "1 2 3 4 5 6 7"
        .Cells(3, 3).Resize(UBound(b)) = Application.Transpose(b)
        .Columns(3).TextToColumns DataType:=xlDelimited, Space:=True
    End With

    Application.DisplayAlerts = True
End Sub

OUI SA MARCHE

Mais le doc que je veux copier c'est NeW-RTT vers t100 voir le doc joint

COLONNE 1 : select F

Colonne 2: Select 1

Colonne 7: Trier du + petit au plus grand

Merci pour l'aide

Boubou

33exo1.xlsm (297.75 Ko)
Sub rcp()
    Application.DisplayAlerts = False
    a = Feuil3.UsedRange
    n = 0

    ReDim b(UBound(a))
    For i = 2 To UBound(a)
        If a(i, 1) = "FF" And a(i, 2) = 1 Then
            For j = 1 To 14
                If IsEmpty(b(n)) Then
                    b(n) = a(i, j)
                Else
                    b(n) = b(n) & Chr(32) & Trim(a(i, j))
                End If
            Next
            n = n + 1
        End If
    Next
    With Feuil2
        .Cells(3, 3).Resize(UBound(b)) = Application.Transpose(b)
        Range(.Cells(3, 3), .Cells(Rows.Count, 3).End(xlUp)).TextToColumns DataType:=xlDelimited, Space:=True
        Range(.Cells(2, 3), .Cells(Rows.Count, 16)).Sort Key1:=.Cells(3, 9), Order1:=xlAscending, Header:=xlYes
    End With
    Application.DisplayAlerts = True
End Sub

SUPER SA MARCHE

Possible d'avoir des commentaires sur ce qui se passe dans le code (Juste pour ma compréhension)

Et que dois-je rajouter si je ne shouhaite oas avoir de NA dans la colonne 7

Dans tous les cas grand merci car sa m'aide BCP

Bonjour

 If a(i, 1) = "FF" And a(i, 2) = 1 And a(i, 7) <> "NA" Then

Première moitié de macro : rassembler les informations "FF 1 FET-002 OTHER Improved 100 0 9,5 NA S"

Deuxième moitié : les dispatcher dans les colonnes.

Rechercher des sujets similaires à "copier nouvelle feuille"