Rechercher dernier numéro

Bonjour,

Le règlement stipule que tout morceau de code doit être publié entre les balises [code]. Merci de modifier tout message qui ne respecterait cet impératif !

Désolée, je viens d'éditer.

 

OMG, quel code horrible ! Avoue, ce n'est pas toi qui a écrit une telle laideur. Seul l'enregistreur de macro peut faire aussi moche. Si tu veux, on peut voir ensemble pour l'améliorer.

En attendant, je comprends ceci. Tu voudrais à la ligne 15, mettre la plus grande valeur de la colonne D. Est-ce bien ça ? Si oui, c'est facile :

WorksheetFunction.Max(Columns("D"))

Bonjour Zeb,

Je ne cacherais pas que c'est l'enregistreur qui a écrit ce code horrible, je débute en macro et j'ai déjà modifié pas mal ce code afin de l'améliorer. Mais bon, j'essaye de me former en parallèle.

Sub extraction_achat()

'

' extraction_achat Macro

' extraction achat pour christelle afin de lui éviter la double saisie des factures achat, fait le 12082010 par elvan

'

' Touche de raccourci du clavier: Ctrl+k

'

     Workbooks.OpenText Filename:="X:\ELGI.CO", Origin:=xlMSDOS, StartRow:=1, _

        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _

        :=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _

        Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _

        Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), _

        Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True

    ActiveWindow.SmallScroll Down:=-18

    Columns("a:a").Select

    Selection.Delete

    Columns("a:a").Select

    Selection.Delete

    Columns("b:b").Select

    Selection.Delete

    Columns("d:d").Select

    Selection.Delete

    Range("A1:M2000").Select

    Selection.Copy

    Sheets.Add After:=Sheets(Sheets.Count)

    Range("A2").Select

    ActiveSheet.Paste

    Columns("A:A").Select

    Application.CutCopyMode = False

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

     Columns("e:e").Select

    Selection.Cut

    Columns("A:A").Select

    ActiveSheet.Paste

    Columns("B:B").Select

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("D:D").Select

    Selection.Cut

    Columns("B:B").Select

    ActiveSheet.Paste

    ActiveWindow.SmallScroll Down:=-9

    Columns("e:e").Select

    Selection.Cut

    Columns("D:D").Select

    ActiveSheet.Paste

    Columns("j:j").Select

    Selection.Cut

    Columns("e:e").Select

    ActiveSheet.Paste

    Columns("G:G").Select

    Selection.Delete Shift:=xlToLeft

    Rows("1:1").Delete

    ActiveWindow.SmallScroll Down:=-117

    Rows("1:1").Select

    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    ActiveWindow.SmallScroll Down:=-9

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$O$1000").AutoFilter Field:=4, Criteria1:="=9*"

    ActiveSheet.Range("$A$1:$O$1000").AutoFilter Field:=1, Criteria1:=">1007210", _

        Operator:=xlAnd

    Range("A1:M2000").Select

    Selection.Copy

    Sheets.Add After:=Sheets(Sheets.Count)

    Range("A1").Select

    ActiveSheet.Paste

    Range("F2").Formula = _

       "=IF(RC[4]=3,""CHQ"",IF(RC[4]=12,""LCR"",IF(RC[4]=13,""LCR"",IF(RC[4]=""PRE"",""PRE"",IF(RC[4]=""LCM"",""LCM"",IF(RC[4]=""CHQ"",""CHQ"",IF(RC[4]=""VIR"",""VIR"",IF(RC[4]=""TRA"",""TRA"",IF(RC[4]=7,""LCR"","""")))))))))"

    Range("F3").Select

    ActiveWindow.SmallScroll Down:=-15

    Range("F2").Select

    Selection.AutoFill Destination:=Range("F2:F438"), Type:=xlFillDefault

    Range("F2:F438").Select

    Range("A2:G125").Select

    Selection.Copy

     ChDir "X:\SANDRINE\ECHEANCIERS"

    Workbooks.Open Filename:="X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls", _

        Origin:=xlWindows

    Sheets.Add After:=Sheets(Sheets.Count)

    Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Columns("G:G").Select

    Application.CutCopyMode = False

    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

    Columns("E:E").Select

    Selection.NumberFormat = "dd/mm/yy;@"

     Columns("B:F").Select

    Range("F1").Activate

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

Voilà la tête qu'il a maintenant, mais il faut que je trouve d'abord la solution à mon premier problème avant de continuer.

Non je ne veux pas la valeur max de la colonne D, ça aurait été simple sinon, je veux qu'il aille me chercher la valeur max des factures saisie dans le fichier de destination, en colonne A( ligne 75 du dernier code). Pour l'instant je suis obligée de retourner et modifier la valeur du filtre manuellement dans la macro.

Merci encore pour ton aide.
Elvan

Je me propose de t'aider sur cet exemple. Mais d'abord, trouvons la solution à ton problème.

Ah, ben c'est quand même plus clair. La valeur est la valeur max à chercher dans la colonne A de tel classeur. Mon exemple reste pertinent, sauf qu'il faut changer le numéro de colonne.

Comme dans ton code on jongle avec plusieurs classeurs, je t'invite à préciser sur quel classeur tu travailles, sans faire confiance à celui qui est actif à un moment donné. De la même façon, ne te fis pas à la cellule active. C'est toujours une mauvaise idée. En plus ton code est très lourd. Tu sélectionnes un objet, puis tu appliques une action sur la sélection. Tu ferais bien mieux d'appliquer l'action directement sur l'objet.

Première chose, on va aller chercher la valeur max dans la colonne A du classeur de destination.

Dim classeur_destination As Workbook

Dim dernier_dossier As Long

 
Set classeur_destination = Workbooks.Open("X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls")

dernier_dossier = WorksheetFunction.Max(classeur_destination.Worksheets(1).Columns(1))

MsgBox "Le dernier dossier est le n°" & dernier_dossier

C'était facile, non ? Si oui, on continue. Si non, étudie bien ce que j'ai fait. Dès que ça te semble facile, on continue  

Bon, maintenant, on ouvre le classeur suivant :

Dim classeur_source As Workbook

 
Set classeur_source = Workbooks.OpenText(Filename:="U:\ELGI.CO", _

                                         Origin:=xlMSDOS, _

                                         DataType:=xlDelimited, _

                                         Tab:=True, _

                                         TrailingMinusNumbers:=True)

As-tu remarqué ? J'ai viré pleins de paramètres. En fait, j'ai retiré tous ceux qui étaient à leur valeur par défaut. C'est juste pour que ce soit lisible.

On continue.

' // Beurk, c'est moche.

Rows("1:1").Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

 
'// Bien. Aucune sélection inutile, en en plus, c'est lisible

Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

N'ai-je pas dit qu'on devait préciser le classeur, et t'en qu'à faire, la feuille ?

'// Encore mieux

classeur_source.Worksheets(1).Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Pour ton propre confort, et si tu n'utilises qu'une feuille par classeur, on peut faire comme ceci :

Dim classeur_destination As Workbook

Dim classeur_source As Workbook

Dim feuille_destination As Worksheet

Dim feuille_source As Worksheet

 
Set classeur_destination = Workbooks.Open("X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls")

Set feuille_destination = classeur_destination.Worksheets(1)

dernier_dossier = WorksheetFunction.Max(feuille_destination.Columns(1))

 
Set classeur_source = Workbooks.OpenText(Filename:="U:\ELGI.CO", Origin:=xlMSDOS, DataType:=xlDelimited, Tab:=True, TrailingMinusNumbers:=True)

Set feuille_source = classeur_source.Worksheets(1)

 
feuille_source.Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Ça va encore ?

Rows("1:1" ).AutoFilter

T'es sûr que tu veux les 256 colonnes de la ligne 1
Mais non. A te lire plus bas, tu ne veux que la zone A1:0400.

feuille_source.Range("A1:O440").AutoFilter

feuille_source.Range("A1:O440").AutoFilter Field:=3, Criteria1:="=9*"

feuille_source.Range("A1:O440").AutoFilter Field:=4, Criteria1:=">" & dernier_dossier, Operator:=xlAnd

feuille_source.Range("A1:O440").AutoFilter Field:=7, Criteria1:="C"

Yeahhhhhhh   On l'a la soluce !!!!
Mais j'ai encore mal au doigts d'avoir taper tout ça. On factorise !

With feuille_source.Range("A1:O440")

    .AutoFilter

    .AutoFilter Field:=3, Criteria1:="=9*"

    .AutoFilter Field:=4, Criteria1:=">" & dernier_dossier, Operator:=xlAnd

    .AutoFilter Field:=7, Criteria1:="C"

End With

La suite :

Range("A2:M438").Select

Selection.Copy

Sheets.Add After:=Sheets(Sheets.Count)

Range("A2").Select

ActiveSheet.Paste

Mais quelle honte. Ce générateur de macro devrait être pendu haut et court. Comment se permettre d'utiliser le presse-papier de l'utilisateur. Et si pendant que ta macro s'exécutait, tu faisais autre chose, pour laquelle l'usage du presse-papier t'était utile. Eh hop, bug ! Par principe, on s'interdit toute utilisation du presse-papier, réservé à l'usage exclusif de l'utilisateur !

Tiens, j'ai bien fait de préciser les feuilles, voilà qu'on en utilise d'autres maintenant.

' // D'abord, on prépare la feuille

Dim feuille_source_filtree As Worksheet

Set feuille_source_filtree = classeur_source.Sheets.Add(After:=classeur_source.Sheets(classeur_source.Sheets.Count))

 
' // Ensuite, on copie, sans passer par le presse-papier

feuille_source.Range("A2:M438").Copy Destination:=feuille_source_filtree.Range("A2")

T'as tout compris ?
Alors reposte-nous ton code, avec les "améliorations" proposées.
J'ai encore des tas de choses à te montrer.  

Bonjour Zeb,

Je vais aimer les macro si ça continue  

Je viens de passer une bonne partie de ma matinée sur cette macro  

En résumé le code 1 (j'ai pas réussi à citer, à vrai dire pas trop le temps non plus de trop chercher car mon boss attend avec impatience le résultat) fonctionne parfaitement mais il me met une erreur en fin de parcours sur la méthode Pastespecial de la classe range a échoué.

Ensuite quand je mets le code 2 concernant le classeur source, il me surligne opentext et s'arrête là. po compris pourquoi  

Ensuite le code 3, erreur 1004 la méthode autofilter de la classe range a échoué.

Code 6, non je ne veux pas les 256 colonnes mais jusque O, et seulement les lignes saisie, c'est pourquoi j'avais mis 440, mais ça peut être plus, je voulais d'abord résoudre les gros problèmes avant de m'ataquer aux autres   .

code 7 Tu es un génie!

Je te montre ce que ça donne pour le moment avec le pastespecial qui ne fonctionne pas.

Dim classeur_destination As Workbook

    Dim dernier_dossier As Long

 
    Set classeur_destination = Workbooks.Open("X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls")

    dernier_dossier = WorksheetFunction.Max(classeur_destination.Worksheets(10).Columns(1))

    MsgBox "Le dernier dossier est le n°" & dernier_dossier

    Workbooks.OpenText Filename:="X:\ELGI.CO", Origin:=xlMSDOS, _

        DataType:=xlDelimited, _

        Tab:=True, _

        TrailingMinusNumbers:=True

    Columns("a:a").Delete

    Columns("a:a").Delete

    Columns("b:b").Delete

    Columns("d:d").Delete

    Range("A1:M2000").Copy

    Sheets.Add After:=Sheets(Sheets.Count)

    Range("A2").Select

    ActiveSheet.Paste

    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("e:e").Cut

    Columns("A:A").Select

    ActiveSheet.Paste

    Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("D:D").Cut

    Columns("B:B").Select

    ActiveSheet.Paste

    Columns("e:e").Cut

    Columns("D:D").Select

    ActiveSheet.Paste

    Columns("j:j").Cut

    Columns("e:e").Select

    ActiveSheet.Paste

    Columns("G:G").Delete Shift:=xlToLeft

    Rows("1:1").Delete

    Rows("1:1").Select

    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$O$1000").AutoFilter Field:=4, Criteria1:="=9*"

    ActiveSheet.Range("$A$1:$O$1000").AutoFilter Field:=1, Criteria1:=">" & dernier_dossier, _

        Operator:=xlAnd

    Range("A1:M2000").Copy

    Sheets.Add After:=Sheets(Sheets.Count)

    Range("A1").Select

    ActiveSheet.Paste

    Range("F2").Formula = _

      "=IF(RC[4]=3,""CHQ"",IF(RC[4]=12,""LCR"",IF(RC[4]=13,""LCR"",IF(RC[4]=""PRE"",""PRE"",IF(RC[4]=""LCM"",""LCM"",IF(RC[4]=""CHQ"",""CHQ"",IF(RC[4]=""VIR"",""VIR"",IF(RC[4]=""TRA"",""TRA"",IF(RC[4]=7,""LCR"","""" )))))))))"

    Range("F2").Select

    Selection.AutoFill Destination:=Range("F2:F438"), Type:=xlFillDefault

    Range("F2:F438").Select

    Range("A2:G125").Select

    Selection.Copy

    ChDir "X:\SANDRINE\ECHEANCIERS"

    Workbooks.Open Filename:="X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls", _

        Origin:=xlWindows

    Sheets.Add After:=Sheets(Sheets.Count)

    Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Columns("G:G").Select

    Application.CutCopyMode = False

    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

    Columns("E:E").Select

    Selection.NumberFormat = "dd/mm/yy;@"

    Columns("B:F").Select

    Range("F1").Activate

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

Arf, je n'ai pas vérifié le code que te te proposais. Le modèle objet d'Excel est incomplet : la méthode OpenText ne renvoie pas le classeur qu'elle ouvre, c'est une hérésie ! Messieurs de chez Microsoft, vous êtes des branques  

Que cela ne nous perturbe pas.

Dim classeur_source As Workbook

Workbooks.OpenText Filename:="U:\ELGI.CO", Origin:=xlMSDOS, DataType:=xlDelimited, Tab:=True, TrailingMinusNumbers:=True

Set classeur_source = Workbooks("ELGI.CO")

Ton code reste bourré de copier/coller. Or justement, je t'ai expliqué que c'est une source énorme de problème d'une part, et que ne pas s'en servir est plus simple, d'autre part.

Zeb,

Voici la macro après les modifications que j'ai pu faire, je comprend mieux comment ça fonctionne mais quelques trucs restent flou encore, je vais bosser dessus.

Dim classeur_destination As Workbook

    Dim dernier_dossier As Long

    Dim classeur_source As Workbook

    Dim feuille_destination As Worksheet

    Dim feuille_source As Worksheet

    Dim feuille_source1 As Worksheet

    Dim feuille_source2 As Worksheet

 
    Set classeur_destination = Workbooks.Open("X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls")

    dernier_dossier = WorksheetFunction.Max(classeur_destination.Worksheets(10).Columns(1))

    Set feuille_destination = classeur_destination.Worksheets(10)

    MsgBox "Le dernier dossier est le n°" & dernier_dossier

 
    Workbooks.OpenText Filename:="X:\ELGI.CO", Origin:=xlMSDOS, _

        DataType:=xlDelimited, _

        Tab:=True, _

        TrailingMinusNumbers:=True

    Set classeur_source = Workbooks.Open("X:\ELGI.co")

    Set feuille_source = classeur_source.Worksheets(1)

    Columns("a:a").Delete

    Columns("a:a").Delete

    Columns("b:b").Delete

    Columns("d:d").Delete

    Range("A1:M2000").Copy

    Sheets.Add After:=Sheets(Sheets.Count)

    Set feuille_source1 = classeur_source.Worksheets(2)

    Range("A2").Select

    ActiveSheet.Paste

    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("e:e").Cut

    Columns("A:A").Select

    ActiveSheet.Paste

    Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("D:D").Cut

    Columns("B:B").Select

    ActiveSheet.Paste

    Columns("e:e").Cut

    Columns("D:D").Select

    ActiveSheet.Paste

    Columns("j:j").Cut

    Columns("e:e").Select

    ActiveSheet.Paste

    Columns("G:G").Delete Shift:=xlToLeft

    Rows("1:1").Delete

    With feuille_source1.Range("A1:O440")

        .AutoFilter

        .AutoFilter Field:=3, Criteria1:="=9*"

        .AutoFilter Field:=4, Criteria1:=">" & dernier_dossier, Operator:=xlAnd

    End With

    Range("A1:M2000").Copy

    Sheets.Add After:=Sheets(Sheets.Count)

    Set feuille_source2 = classeur_source.Worksheets(3)

    Range("A1").Select

    ActiveSheet.Paste

    Range("F2").Formula = _

      "=IF(RC[4]=3,""CHQ"",IF(RC[4]=12,""LCR"",IF(RC[4]=13,""LCR"",IF(RC[4]=""PRE"",""PRE"",IF(RC[4]=""LCM"",""LCM"",IF(RC[4]=""CHQ"",""CHQ"",IF(RC[4]=""VIR"",""VIR"",IF(RC[4]=""TRA"",""TRA"",IF(RC[4]=7,""LCR"","""" )))))))))"

    Range("F2").Select

    Selection.AutoFill Destination:=Range("F2:F438"), Type:=xlFillDefault

    Range("F2:F438").Select

    Range("A2:G125").Select

    Selection.Copy

    ChDir "X:\SANDRINE\ECHEANCIERS"

    Workbooks.Open Filename:="X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls", _

        Origin:=xlWindows

    Sheets.Add After:=Sheets(Sheets.Count)

    Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Columns("G:G").Select

    Application.CutCopyMode = False

    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

    Columns("E:E").Select

    Selection.NumberFormat = "dd/mm/yy;@"

    Columns("B:F").Select

    Range("F1").Activate

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

La méthode paste spécial ne fonctionne toujours pas. Je lui ai demandé de me rajouter une nouvelle feuille dans le classeur de destination, car je ne sais pas comment faire pour qu'il me colle le résultat final à la fin de la feuille destination, à la dernière ligne de saisie.

Merci encore pour ton aide si précieuse.

Elvan

Bon. Ton code n'est pas beau. On va le rendre beau. Et quand ce sera fait, la solution sautera aux yeux. Ben oui, c'est pour ça qu'il faut faire l'effort de faire les choses bien.

Dim classeur_destination As Workbook

Dim dernier_dossier As Long

Dim classeur_source As Workbook

Dim feuille_destination As Worksheet

Dim feuille_source1 As Worksheet

Dim feuille_source2 As Worksheet

 
Set classeur_destination = Workbooks.Open("X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls")

dernier_dossier = WorksheetFunction.Max(classeur_destination.Worksheets(10).Columns(1))

 
Set feuille_destination = classeur_destination.Worksheets(10)

' // Faudra virer cette ligne à la fin

MsgBox "Le dernier dossier est le n°" & dernier_dossier

 
Workbooks.OpenText Filename:="X:\ELGI.CO", Origin:=xlMSDOS, _

    DataType:=xlDelimited, _

    Tab:=True, _

    TrailingMinusNumbers:=True

 
' // Il est déjà ouvert !

'xxxx Set classeur_source = Workbooks.Open("X:\ELGI.co")

Set classeur_source = Workbooks("X:\ELGI.co")

 
Set feuille_source1 = classeur_source.Worksheets(1)

 
' // Eh, tu ne précises pas sur quel classeur ni sur quelle feuille tu travailles.

' // C'est mal.

' // Un conseil : pars toujouts du bas vers le haut

' //              et de la droite vers la gauche

' //              pour supprimer dans un tableau

'xxxx Columns("a:a").Delete

'xxxx Columns("a:a").Delete

'xxxx Columns("b:b").Delete

'xxxx Columns("d:d").Delete

 
' // Solution 1 - Quatre actions

feuille_source1.Columns("G").Delete

feuille_source1.Columns("D").Delete

feuille_source1.Columns("B").Delete

feuille_source1.Columns("A").Delete

' // Solution 2 - Une seule action

feuille_source1.Range(feuille_source1.Columns("A"), _

                      feuille_source1.Columns("B"), _

                      feuille_source1.Columns("D"), _

                      feuille_source1.Columns("G")).Delete

' // Solution 3 - Une seule action

feuille_source1.Range("A:A,B:B,D:D,G:G").Delete

 
' // GRRRRRR J'ai dit, plus de copier/coller

' // Et puis, il n'y a toujours pas de référence au classeur !

'xxxx Range("A1:M2000").Copy

'xxxx Sheets.Add After:=Sheets(Sheets.Count)

'xxxx Set feuille_source1 = classeur_source.Worksheets(2)

'xxxx Range("A2").Select

'xxxx ActiveSheet.Paste

Set feuille_source2 = classeur_source.Sheets.Add(After:=Sheets(Sheets.Count))

feuille_source1.Range("A1:M2000").Copy Destination:=feuille_source1.Range("A2")

 
' // GRRRRRR Des couper/coller maintenant et toujours pas de référence au classeur/feuille !

' // Et pourquoi s'est-on emmerder à tout copier ?

' // On vire la ligne précédente, et on copie ce qu'on veut, là où on veut

 
'xxxx Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'xxxx Columns("e:e").Cut

'xxxx Columns("A:A").Select

'xxxx ActiveSheet.Paste

 
feuille_source1.Columns("F").Copy Destination:=feuille_source1.Columns("A")

feuille_source1.Columns("G").Copy Destination:=feuille_source1.Columns("B")

feuille_source1.Columns("H").Copy Destination:=feuille_source1.Columns("C")

....

' // ( à toi de vérifier quelles sont les colonnes que tu veux copier )

 
 
' // Correct, mais je te propose d'autres écritures

' Ta soluce

Rows("1:1").Delete

' Autre solution

Rows("1").Delete

' Autre solution

Rows(1).Delete

Continues comme ça.. En attendant, je regarde tes problèmes....
 

Bonjour Zeb,

J'ai modifié en fonction de ton aide, voilà le résultat. Je vois que l'on peut faire assez simple quand on se penche vraiment dessus. Merci beaucoup!!!!!!

Dim classeur_destination As Workbook

    Dim dernier_dossier As Long

    Dim classeur_source As Workbook

    Dim feuille_destination As Worksheet

    Dim feuille_source As Worksheet

    Dim feuille_source1 As Worksheet

    Dim feuille_source2 As Worksheet

    Dim feuille_destination1 As Worksheet

 
    Set classeur_destination = Workbooks.Open("X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls")

    dernier_dossier = WorksheetFunction.Max(classeur_destination.Worksheets(10).Columns(1))

 
    Set feuille_destination = classeur_destination.Worksheets(10)

    MsgBox "Le dernier dossier est le n°" & dernier_dossier

 
    Workbooks.OpenText Filename:="X:\ELGI.CO", Origin:=xlMSDOS, _

        DataType:=xlDelimited, _

        Tab:=True, _

        TrailingMinusNumbers:=True

    Set classeur_source = Workbooks.Open("X:\ELGI.co")

    Set feuille_source = classeur_source.Worksheets(1)

    feuille_source.Range("A:A,B:B,D:D,G:G").Delete

    Set feuille_source1 = classeur_source.Sheets.Add(after:=Sheets(Sheets.Count))

    feuille_source.Range("A1:M2000").Copy Destination:=feuille_source1.Range("A2")

    feuille_source1.Columns("a").Insert shift:=xlToRight, copyorigin:=xlFormatFromLeftOrAbove

    feuille_source1.Columns("e").Cut Destination:=feuille_source1.Columns("A")

     feuille_source1.Columns("b").Insert shift:=xlToRight, copyorigin:=xlFormatFromLeftOrAbove

    feuille_source1.Columns("d").Cut Destination:=feuille_source1.Columns("B")

    feuille_source1.Columns("e").Cut Destination:=feuille_source1.Columns("d")

    feuille_source1.Columns("j").Cut Destination:=feuille_source1.Columns("e")

    feuille_source1.Columns("g").Delete

    Rows(1).Delete

    With feuille_source1.Range("A1:O440")

        .AutoFilter

        .AutoFilter Field:=3, Criteria1:="=9*"

        .AutoFilter Field:=4, Criteria1:=">" & dernier_dossier, Operator:=xlAnd

    End With

    Set feuille_source2 = classeur_source.Sheets.Add(after:=Sheets(Sheets.Count))

    feuille_source1.Range("a1:m2000").Copy Destination:=feuille_source2.Range("a2")

    Range("F2").Formula = _

      "=IF(RC[4]=3,""CHQ"",IF(RC[4]=12,""LCR"",IF(RC[4]=13,""LCR"",IF(RC[4]=""PRE"",""PRE"",IF(RC[4]=""LCM"",""LCM"",IF(RC[4]=""CHQ"",""CHQ"",IF(RC[4]=""VIR"",""VIR"",IF(RC[4]=""TRA"",""TRA"",IF(RC[4]=7,""LCR"","""" )))))))))"

    Range("F2").Select

    Selection.AutoFill Destination:=Range("F2:F438"), Type:=xlFillDefault

    Range("F2:F438").Select

    feuille_source2.Range("A2:G125").Copy

    ChDir "X:\SANDRINE\ECHEANCIERS"

    Workbooks.Open Filename:="X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls", _

        Origin:=xlWindows

    Sheets.Add after:=Sheets(Sheets.Count)

    Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Columns("G:G").Select

    Application.CutCopyMode = False

    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

    Columns("E:E").Select

    Selection.NumberFormat = "dd/mm/yy;@"

    Columns("B:F").Select

    Range("F1").Activate

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

Il est plus beau maintenant?  

C'est mieux. Mais...

Lignes 32, 40, 42, 44, 50, 53, 56, 58, 59, tu n'indiques pas la feuille concernée.
Lignes 42/43, 44/45, 50/51, 53/55, 56/57, 58/60, tu as encore du Select/Selection.
Ligne 45/51, tu passes par le presse-papier.

Ligne 47, tu ouvres un classeur. Mets-le dans une variable Workbook. Utilise cette variable pour faire une autre variable de type Worksheet qui pointera sur la nouvelle feuille (ligne 49).

Règle tous ces petits problèmes, et ton gros problème devrait disparaître  

Est-ce clair pour toi ?

Bonjour Zeb,

J'ai fais les modifications nécessaires, mais le résultat du paste special est toujours pas bon.

Dim classeur_destination As Workbook

    Dim dernier_dossier As Long

    Dim classeur_source As Workbook

    Dim feuille_destination As Worksheet

    Dim feuille_source As Worksheet

    Dim feuille_source1 As Worksheet

    Dim feuille_source2 As Worksheet

    Dim feuille_destination1 As Worksheet

 
    Set classeur_destination = Workbooks.Open("X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls")

    dernier_dossier = WorksheetFunction.Max(classeur_destination.Worksheets(10).Columns(1))

 
    Set feuille_destination = classeur_destination.Worksheets(10)

    MsgBox "Le dernier dossier est le n°" & dernier_dossier

 
    Workbooks.OpenText Filename:="X:\ELGI.CO", Origin:=xlMSDOS, _

        DataType:=xlDelimited, _

        Tab:=True, _

        TrailingMinusNumbers:=True

    Set classeur_source = Workbooks.Open("X:\ELGI.co")

    Set feuille_source = classeur_source.Worksheets(1)

    feuille_source.Range("A:A,B:B,D:D,G:G").Delete

    Set feuille_source1 = classeur_source.Sheets.Add(after:=Sheets(Sheets.Count))

    feuille_source.Range("A1:M2000").Copy Destination:=feuille_source1.Range("A2")

    feuille_source1.Columns("a").Insert shift:=xlToRight, copyorigin:=xlFormatFromLeftOrAbove

    feuille_source1.Columns("e").Cut Destination:=feuille_source1.Columns("A")

     feuille_source1.Columns("b").Insert shift:=xlToRight, copyorigin:=xlFormatFromLeftOrAbove

    feuille_source1.Columns("d").Cut Destination:=feuille_source1.Columns("B")

    feuille_source1.Columns("e").Cut Destination:=feuille_source1.Columns("d")

    feuille_source1.Columns("j").Cut Destination:=feuille_source1.Columns("e")

    feuille_source1.Columns("g").Delete

    feuille_source1.Rows(1).Delete

    With feuille_source1.Range("A1:O440")

        .AutoFilter

        .AutoFilter Field:=3, Criteria1:="=9*"

        .AutoFilter Field:=4, Criteria1:=">" & dernier_dossier, Operator:=xlAnd

    End With

    Set feuille_source2 = classeur_source.Sheets.Add(after:=Sheets(Sheets.Count))

    feuille_source1.Range("a1:m2000").Copy Destination:=feuille_source2.Range("a2")

    feuille_source2.Range("F2").Formula = _

      "=IF(RC[4]=3,""CHQ"",IF(RC[4]=12,""LCR"",IF(RC[4]=13,""LCR"",IF(RC[4]=""PRE"",""PRE"",IF(RC[4]=""LCM"",""LCM"",IF(RC[4]=""CHQ"",""CHQ"",IF(RC[4]=""VIR"",""VIR"",IF(RC[4]=""TRA"",""TRA"",IF(RC[4]=7,""LCR"","""" )))))))))"

    feuille_source2.Range("F2").AutoFill Destination:=Range("F2:F438"), Type:=xlFillDefault

    Set feuille_destination1 = classeur_destination.Sheets.Add(after:=Sheets(Sheets.Count))

    feuille_source2.Range("A2:G125").Copy Destination:=feuille_destination1.Range("a1")

    feuille_destination1.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    feuille_destination1.Columns("G:G").Application.CutCopyMode = False

    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

    feuille_destination1.Columns("E:E").NumberFormat = "dd/mm/yy;@"

    With feuille_destination1.Columns("a:g")

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

End Sub

Ce qui est bien avec ton aide, c'est que tu donnes pas la solution, mais cherche à faire comprendre le fonctionnement. J'y vois plus clair déjà.
Merci

Merci d'accepter mon aide. Certains viennent chercher ici des solutions, pas des leçons, ni des exercices.
 

Bon, je vois que tu arrives au bout de tes compétences. Je peux maintenant apporter une plus-value qui te soit vraiment profitable.
 

Ligne 38, 42 et 43

Set feuille_source2 = classeur_source.Sheets.Add(after:=Sheets(Sheets.Count))
feuille_source2.Range("F2" ).AutoFill Destination:=Range("F2:F438" ), Type:=xlFillDefault
Set feuille_destination1 = classeur_destination.Sheets.Add(after:=Sheets(Sheets.Count))

Et non.  
Il faut préciser le classeur, la feuille partout !

Set feuille_source2 = classeur_source.Sheets.Add(after:=classeur_source.Sheets(classeur_source.Sheets.Count))
feuille_source2.Range("F2" ).AutoFill Destination:=feuille_source2.Range("F2:F438" ), Type:=xlFillDefault
Set feuille_destination1 = classeur_destination.Sheets.Add(after:=classeur_destination.Sheets(classeur_destination.Sheets.Count))

Comment ça c'est lourd-dingue ?
Ben c'est pour ça qu'on a inventer la clause With :

With classeur_source
    Set feuille_source2 = .Sheets.Add(after:=.Sheets(.Sheets.Count))
End With
 
With feuille_source2
    .Range("F2" ).AutoFill Destination:=.Range("F2:F438" ), Type:=xlFillDefault
End With
 
With classeur_destination
    Set feuille_destination1 = .Sheets.Add(after:=.Sheets(Sheets.Count))
End With

Personnellement, j'utilise peu les clauses With. Le code résultat devient trop difficile à lire. En revanche, j'utilise des noms de variable plus courts.
Par exemple, wbTarget ou wsSource où wb signifie Workbook (classeur), ws signifie Worksheet (feuille).
J'utilise des mots anglais pour leur concision, et l'absence d'accent. Parfois j'abrège les mots évident.
Quand j'ai plusieurs sources et cibles, je définit mes variables comme ça :

Dim wbS  As Workbook
Dim wsS1 As Worksheet
Dim wsS2 As Worksheet
Dim wbT  As Workbook
Dim wsT1 As Workbook
Dim wsT2 As Workbook

Le code lourd-dingue devient :

Set wsS2 = wsS.Sheets.Add(after:=wsS.Sheets(wsS.Sheets.Count))

Ca devient raisonnable.
Il n'y a pas une meilleure façon de définir les variables. Il s'agit du style de l'auteur.
 

Revenons à ton (ou plutôt celui de l'enregistreur de macro) code pas beau d'autrefois :

feuille_source2.Range("A2:G125" ).Copy
ChDir "X:\SANDRINE\ECHEANCIERS"
Workbooks.Open Filename:="X:\SANDRINE\ECHEANCIERS\2010 ech fournisseur.xls", Origin:=xlWindows
Sheets.Add after:=Sheets(Sheets.Count)
Range("A1" ).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
feuille_destination1.Columns("G:G" ).Application.CutCopyMode = False

En français, tu veux copier les données de la feuille source 2 vers une nouvelle page du fichier de Sandrine, mais sans formule, juste les valeurs.
Comme je ne veux pas voir de passage par le presse-papier, tu aurais dû m'écrire :

Set feuille_destination1 = classeur_destination.Sheets.Add(after:=classeur_destination.Sheets(classeur_destination.Sheets.Count))
feuille_source2.Range("A2:G125" ).Copy Destination:=feuille_destination1.Range("A1" )

Et c'est tout. Pas de PasteSpecial, ni de CutCopyMode = False.
Et surtout pas avec la syntaxe proposée :

feuille_destination1.Columns("G:G" ).Application.CutCopyMode = False

Le mode couper/copier dépend de l'application (Excel), pas d'une cellule.
Mais bref, on s'en fout, on ne veut plus de cette ligne.

Seulement, voilà, avec cette façon de faire, ce ne sont pas les valeurs mais les formules qui sont copiées.  
Comment faire ?
Solution crade : passer par le presse-papier. Comme je suis un intégriste de la programmation (*), il n'en est pas question.
Solution admissible : copier chaque valeur une à une. C'est parti.

Dim colonne As Integer
Dim ligne As Long
 
For colonne = 1 To 7 ' // De A à G
    For ligne = 2 To 125
    	feuille_destination1.Cells(ligne - 1, colonne).Value = feuille_source2.Cells(ligne, colonne).Value
	Next
Next

EDIT: Manquait la propriété Value à la ligne 5

Autre façons de faire :

Dim cell As Range
 
For Each cellule In Feuil1.Range("A7:B8")
    Feuil2.Cells(cellule.Row - 1, cellule.Column).Value = cellule.Value
Next

PS: Vire-moi le Selection de la ligne 48.  

Tout ça t'aide-t-il ?
 
______________
(*) Sorte de religion avec plusieurs mouvances.
Les ultra-orthodoxes-intégristes y programment en C/shell, les dévôts en VB, les séminaristes en Pascal, les observateurs de la Sainte Programmation en Lisp, ....

 

Zeb,

ci dessous les modification rapportées. Tout ça m'aide et je me baserais sur cette macro pour en faire d'autres derrière.

With classeur_source

    Set feuille_source2 = .Sheets.Add(after:=.Sheets(.Sheets.Count))

    End With

    feuille_source1.Range("a1:m2000").Copy Destination:=feuille_source2.Range("a2")

    feuille_source2.Range("F2").Formula = _

      "=IF(RC[4]=3,""CHQ"",IF(RC[4]=12,""LCR"",IF(RC[4]=13,""LCR"",IF(RC[4]=""PRE"",""PRE"",IF(RC[4]=""LCM"",""LCM"",IF(RC[4]=""CHQ"",""CHQ"",IF(RC[4]=""VIR"",""VIR"",IF(RC[4]=""TRA"",""TRA"",IF(RC[4]=7,""LCR"","""" )))))))))"

    With feuille_source2

        .Range("F2").AutoFill Destination:=.Range("F2:F438"), Type:=xlFillDefault

    End With

    With classeur_destination

    Set feuille_destination1 = .Sheets.Add(after:=.Sheets(.Sheets.Count))

    End With

    Dim columns As Integer

    Dim ligne As Long

    For columns = 1 To 7

    For ligne = 2 To 125

    feuille_destination1.Cells(ligne - 1, columns).Value = feuille_source2.Cells(ligne, columns)

    Next

    Next

Cependant j'ai deux quesions à te poser :

* quand je récupère mon fichier de l'extraction comptable je n'ai plus les montants des factures. Ils ne s'affichent pas correctement
(avant je n'avais pas ce problème). Le montant s'affiche comme celà "000000001139,19", en cliquant dessus je peux les convertir en nombre et là le résultat est correct.
* Au lieu de coller la dernière sélection dans une nouvelle feuille dans le classeur de destination, j'aimerais qu'il aille me coller ça à la suite de la feuille_destination, en dessous des autres lignes saisies. (donnes moi un exemple comme ça ça me fait de l'exercice).

Merci

Meilleure réponse sélectionnée par elvan28.