Code VB à réaliser SVP

[Frenatchl]

Bonjour,

j'aurais besoin d'une âme charitable pour me coder une macro en VB. Ca ne devrait pas être compliqué.

je reçois une dizaine de fichier (disons A1 à A10) qui sont formatés exactement pareil, sur le modèle du fichier joint. Dans ces fichiers, des utilisateurs ont insérés des lignes.

je voudrais un macro qui consolide tout ça en un seul fichier A.xls
C'est-à-dire :
* ouvre fichier A1, copie les lignes, colle-les dans A.xls
* ouvre fichier A2, ..., colle-les dans A.xls à la suite des précédentes
* etc ...
* jusqu'à A10

NB1 :
Attention, il se pourrait que dans les fichiers Ai.xls, il y ait une ligne vide au beau milieu des autres. Donc éviter les algorithmes qui copieraient les lignes les unes après les autres, jusqu'à une ligne vide ... car ce n'est peut-être pas la fin des lignes à copier.

NB2 :
pour des raisons techniques, il ne faut copier que les 4 premières colonnes de chaque ligne, et pas la ligne entière.

Voilà, si vous voulez être assez sympa pour me le coder dans le fichier joint, ça me rendrait un fier service.

Merci d'avance ! [file name=A_20060316224019.zip size=1992]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/A_20060316224019.zip[/file]

 

[pat1545.]

Salut,

nuit blanche alors..
un debut de soluce avec ceci, à toi de modifier et adapter

Bye

 

[ODVJ]

Bonsoir,

un exemple de code sans fioritures mais qui fait le principal :
1) les fichiers A1.XLS à A10.XLS sont copiés/collés_valeur dans un fichier A.XLS
2) les lignes vides sont éliminées
3) seules les colonnes 1 à 4 sont prises

à mettre dans un module de A.XLS, modifier le chemin de la variable VNOMDEB et faire en sorte que les Ai.XLS soint dans le même répertoire que A.XLS

Sub Concatene_fichier()
vnomdeb = 'C:\\Documents and Settings\\Jean\\Mes documents\\A'
For i = 1 To 10
Workbooks.Open Filename:= _
vnomdeb & i & '.xls'
vmax = WorksheetFunction.Max(Range('A65536').End(xlUp).Row, Range('b65536').End(xlUp).Row, Range('c65536').End(xlUp).Row, Range('d65536').End(xlUp).Row)
Range('A1' & vmax).Copy
Windows('A.xls').Activate
vmax = WorksheetFunction.Max(Range('A65536').End(xlUp).Row, Range('b65536').End(xlUp).Row, Range('c65536').End(xlUp).Row, Range('d65536').End(xlUp).Row) + 1
Range('A' & vmax).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows('A' & i & '.xls').Activate
ActiveWindow.Close
Next
Columns('A:A').Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range('A1').Select
ActiveCell.FormulaR1C1 = '1'
Range('A1').Select
vmax = WorksheetFunction.Max(Range('A65536').End(xlUp).Row, Range('b65536').End(xlUp).Row, Range('c65536').End(xlUp).Row, Range('d65536').End(xlUp).Row)
Selection.AutoFill Destination:=Range('A1:A' & vmax), Type:=xlFillSeries
Range('A1:E' & vmax).Select
Selection.Sort Key1:=Range('B2'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Sort Key1:=Range('C2'), Order1:=xlAscending, Key2:=Range('D2') _
, Order2:=xlAscending, Key3:=Range('E2'), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
vmax1 = WorksheetFunction.Max(Range('b65536').End(xlUp).Row, Range('c65536').End(xlUp).Row, Range('d65536').End(xlUp).Row, Range('e65536').End(xlUp).Row)
Rows(vmax1 + 1 & ':' & vmax).Select
Selection.Delete Shift:=xlUp
Range('A1:E15').Select
Selection.Sort Key1:=Range('A1'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns('A:A').Select
Selection.Delete Shift:=xlToLeft
ActiveWorkbook.Save
End Sub

 

[pat1545.]

re
mon zip est pas passé :-( [file name=essai_20060317104210.zip size=24998]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/essai_20060317104210.zip[/file]

 

[frenatchl]

Super, merci à vous deux !