Code VB à réaliser SVP

  • Initiateur de la discussion Initiateur de la discussion Frenatchl
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

F

Frenatchl

Guest
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]
 

Pièces jointes

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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
559
Compte Supprimé 979
C
Réponses
3
Affichages
953
Retour