Modifier code VBA

Bonjour,

Ci-dessous un code que j'utilise (Transmis sur ce forum)

J'aimerai pouvoir rajouter des choses

1- Triez du + petit au plus grand sur la feuille 2 colonne I

2- Immaginons que la Feuille 2 se trouve dans un autre classeur ("U:\OPERATIONS\test1.xlsm")

Sub Bouton24_Cliquer()

i = 3

j = 3

While Feuil3.Range("A" & i) <> ""

If Feuil3.Range("A" & i) = "FF" Or Feuil3.Range("A" & i) = "II" Or Feuil3.Range("A" & i) = "TT" And Feuil3.Range("D" & i) = "OTHER" Then

Feuil2.Range("C" & j) = Feuil3.Range("A" & i)

Feuil2.Range("D" & j) = Feuil3.Range("B" & i)

Feuil2.Range("E" & j) = Feuil3.Range("C" & i)

Feuil2.Range("F" & j) = Feuil3.Range("D" & i)

Feuil2.Range("G" & j) = Feuil3.Range("E" & i)

Feuil2.Range("H" & j) = Feuil3.Range("F" & i)

Feuil2.Range("I" & j) = Feuil3.Range("G" & i) 'ranger Feuil2.Range("I" & j) du plus petit au plus grand

j = j + 1

End If

i = i + 1

Wend

End Sub

J'espère que c'est assez claire, selon les données cela peut prendre du temps alors si quelqu'un à d'autres idées je

suis fortement intéressé

Merci encore pour l'aide

BOUBOU

Bonjour,

à tester

Sub Bouton24_Cliquer()
    I = 3
    j = 3
    Set twb = ThisWorkbook
    Set owb = Workbooks.Open("U:\OPERATIONS\test1.xlsm")
    While Feuil3.Range("A" & I) <> ""
        If owb.Feuil3.Range("A" & I) = "FF" Or owb.Feuil3.Range("A" & I) = "II" Or owb.Feuil3.Range("A" & I) = "TT" And owb.Feuil3.Range("D" & I) = "OTHER" Then
            owb.Range("A" & I & ":G" & I).Copy twb.feuil2.Range("C" & j)
            j = j + 1
        End If
        I = I + 1
    Wend
    With twb.feuil2
        .Range("C3:I" & j - 1).Sort key1:=.range("i3"), order1:=xlAscending, Header:=xlNo
    End With
End Sub

Super cela répond complètement a ce que je souhaite

Par contre immaginons et ce qui est mon cas que le fichier source a collées ont des colonne discontinu

J'explique

1 colonne A

2 colonne D

3 colonne F

4 colonne W

ETC......

Merci pour l'avancée

bonjour,

dans ce cas copier les cellules une par une.

Bonjour

Tu veux dire comme cela

Feuil2.Range("C" & j) = Feuil3.Range("A" & i)

Feuil2.Range("D" & j) = Feuil3.Range("B" & i)

Feuil2.Range("E" & j) = Feuil3.Range("C" & i)

Feuil2.Range("F" & j) = Feuil3.Range("D" & i)

Feuil2.Range("G" & j) = Feuil3.Range("E" & i)

Feuil2.Range("H" & j) = Feuil3.Range("F" & i)

Feuil2.Range("I" & j) = Feuil3.Range("G" & i)

C'est assez long existe-t-il une autre manière

Meri d'avance

Bonsoir,

une autre méthode, je ne sais pas si elle plus rapide...

Sub Bouton24_Cliquer()
    I = 3
    j = 3
    Set twb = ThisWorkbook
    Set owb = Workbooks.Open("U:\OPERATIONS\test1.xlsm")
    While Feuil3.Range("A" & I) <> ""
        If owb.Feuil3.Range("A" & I) = "FF" Or owb.Feuil3.Range("A" & I) = "II" Or owb.Feuil3.Range("A" & I) = "TT" And owb.Feuil3.Range("D" & I) = "OTHER" Then
with owb.Feuil3
set pl=union(.range("A" & i),.range("D" & i),.range("F" & i),.range("W" & i))
end with
            pl.Copy twb.feuil2.Range("C" & j)
            j = j + 1
        End If
        I = I + 1
    Wend
    With twb.feuil2
        .Range("C3:I" & j - 1).Sort key1:=.range("i3"), order1:=xlAscending, Header:=xlNo
    End With
End Sub