XL 2010 Recuperation de données

philmaure

XLDnaute Impliqué
bonjour,

chaque jour je dois récupérer les donnes de J et J-1 de 2 colonnes.

Je sais identifier la dernière cellule vide de la colonne avec :

Range("u65536").End(xlUp).Offset(1, 0).Select

comment copier les 4 valeurs dont j'ai besoin pour les coller dans l'onglet destinataires de mon fichier test.


Merci pour votre aide

Cdlt
Philmaure
 

Pièces jointes

  • recuperation de données.xlsx
    218.1 KB · Affichages: 27

Hieu

XLDnaute Impliqué
Salut,

Voilà qui doit faire ce que tu veux :
VB:
Sub lkjm()
Set rec = Sheets("Recap J")
Set det = Sheets("destinataires")
Do
If IsNumeric(rec.Range("u65536").End(xlUp).Offset(i, 0)) Then
    det.Range("a1") = rec.Range("u65536").End(xlUp).Offset(i - 1, -2)
    det.Range("a2") = rec.Range("u65536").End(xlUp).Offset(i, -2)
    det.Range("b1") = rec.Range("u65536").End(xlUp).Offset(i - 1, 0)
    det.Range("b2") = rec.Range("u65536").End(xlUp).Offset(i, 0)
    Exit Sub
End If
i = i - 1
Loop
End Sub

++
 

Pièces jointes

  • recuperation de données_v0.xlsm
    227.1 KB · Affichages: 33

Hieu

XLDnaute Impliqué
Of course !!

Petite modif :
VB:
Sub lkjm()
Application.ScreenUpdating = False
chemin = ThisWorkbook.Path & "\"

entree = ThisWorkbook.Name
sortie = "toto.xlsx"

Workbooks.Open (chemin & sortie)
Set rec = Workbooks(entree).Sheets("Recap J")
Set det = Workbooks(sortie).Sheets("destinataires")
Do
If IsNumeric(rec.Range("u65536").End(xlUp).Offset(i, 0)) Then
    det.Range("a1") = rec.Range("u65536").End(xlUp).Offset(i - 1, -2)
    det.Range("a2") = rec.Range("u65536").End(xlUp).Offset(i, -2)
    det.Range("b1") = rec.Range("u65536").End(xlUp).Offset(i - 1, 0)
    det.Range("b2") = rec.Range("u65536").End(xlUp).Offset(i, 0)
    Workbooks("toto.xlsx").Close True
    Exit Sub
End If
i = i - 1
Loop

End Sub

A adapter selon besoin
 

philmaure

XLDnaute Impliqué
re,

j'essaie d'appeler une autre macro à la fin de celle -ci mais cela ne fonctionne pas. Je crois que c'est du à "Exit sub"

Ma ligne de commande est : call macro 6

Avez vous une solution pour que cela soit possible.

Merci pour votre aide
Cdlt
Philippe
 

Hieu

XLDnaute Impliqué
Peux-tu coller le fichier et/ou le bout de code ??

SInon, peut etre ainsi :
VB:
Sub lkjm()
Application.ScreenUpdating = False
chemin = ThisWorkbook.Path & "\"

entree = ThisWorkbook.Name
sortie = "toto.xlsx"

Workbooks.Open (chemin & sortie)
Set rec = Workbooks(entree).Sheets("Recap J")
Set det = Workbooks(sortie).Sheets("destinataires")
Do
If IsNumeric(rec.Range("u65536").End(xlUp).Offset(i, 0)) Then
    det.Range("a1") = rec.Range("u65536").End(xlUp).Offset(i - 1, -2)
    det.Range("a2") = rec.Range("u65536").End(xlUp).Offset(i, -2)
    det.Range("b1") = rec.Range("u65536").End(xlUp).Offset(i - 1, 0)
    det.Range("b2") = rec.Range("u65536").End(xlUp).Offset(i, 0)
    Workbooks("toto.xlsx").CloseTrue
   Exit Do
EndIf
i = i - 1
Loop

call marco6

EndSub

++
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 963
Messages
2 093 996
Membres
105 906
dernier inscrit
aifa