Transfert de données via macro

[guenfood]

Bonjour,

J'ai un fichier 'Pointage' qui doit reprendre des données de 2 autres fichiers 'Couv' et 'Vrai'.
De ces 2 fichiers, il faut reprendre les données à partir de la ligne 12 (et donc occulter les lignes précédentes) jusqu'à la fin.
Pour corser un peu, dans le fichier 'Pointage', une fois que les données du fichier 'couv' sont importées, il faut que celles du fichier 'vrai' viennent se 'coller' à la suite, en sachant que cette opération, je devrais la faire quotidiennement, et que le nombre de lignes de ces 2 fichiers est aléatoire.
Dans les colonnes A,B,C,D,E du fichier 'pointage', il faut reprendre les colonnes A,B,C,D,E des 2 autres fichiers, et dans les colonnes G,H,I,J,K du fichier 'pointage', il faut reprendre les données des colonnes F,G,H,I,J de 'couv' et 'vrai'.

Je suis un peu coincé pour réaliser ceci.
C'est pourquoi je sollicite votre aide.
Je joins donc ces 3 fichiers en pièce jointe.

Merci par avance. [file name=pointage.zip size=33446]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/pointage.zip[/file]

Message édité par: guenfood, à: 19/08/2005 11:26

Message édité par: guenfood, à: 19/08/2005 16:23

 

[GUENFOOD]

Re😛roblème d'ajout de données

Help !!
Je sais que ca ne se fait pas, mais il faut que je réalise ce tableau le plus rapidement possible.
Je vais appel à vos compétences pour m'aider à résoudre ce problème.

Un énorme merci par avance.

 

[ChTi160]

Re😛roblème d'ajout de données

Salut GUENFOOD
voila ce que j'ai mis dans un module du classeur pointage

tu devrais arriver a avoir mieux

Sub transfert()
Dim myarray
Dim chemin As String
 myarray = Array('Couv', 'Vrai')
ChDir ThisWorkbook.Path
For L = 0 To 1
Workbooks.Open Filename:=myarray(L) & '.xls'
With Workbooks(myarray(L) & '.xls').Sheets(1)
derlgn = .Range('A65536').End(xlUp).Row
Maplage = .Range('A12:J' & derlgn).Select
Selection.Copy
End With
Application.ScreenUpdating = False
With Workbooks('pointage1.xls').Sheets(1)
         .Activate
derlgn = .Range('A65536').End(xlUp).Row
         .Range('A' & derlgn).Select
 ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns(6).ClearContents
     Range('F1').Select
    ActiveCell.FormulaR1C1 = '=IF(RC[-1]<0,''-'',''+'')'
    derlgn = .Range('E65536').End(xlUp).Row
    Range('F1').Select
    Selection.AutoFill Destination:=Range('F1:F' & derlgn)
    
End With
With Workbooks(myarray(L) & '.xls')
         .Saved = True
         .Close
End With
Next
Application.ScreenUpdating = True
End Sub