XL 2010 Recuperation de données

philmaure · 28 Juillet 2016

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

Hieu · 28 Juillet 2016

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

++

philmaure · 28 Juillet 2016

bonjour et un grand merci pour la solution
bon a-m
cdlt
Philmaure

philmaure · 28 Juillet 2016

re,

je me rend compte qu'en fait je dois recopier les données dans une autre fichier.
Il faut sans doute changer de ce fait det ?

Cdlt
Philmaure

gosselien · 28 Juillet 2016

philmaure à dit:
re,

je me rend compte qu'en fait je dois recopier les données dans une autre fichier.
Il faut sans doute changer de ce fait det ?

Cdlt
Philmaure

Oui

Hieu · 28 Juillet 2016

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 · 28 Juillet 2016

re,

super, merci

Cdlt
Philmaure

philmaure · 28 Juillet 2016

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 · 28 Juillet 2016

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

++

philmaure · 29 Juillet 2016

bonjour,

un grand merci pour la solution.

Bonne journée
Cdlt
Philmaure

XL 2010 Recuperation de données

philmaure

XLDnaute Impliqué

Pièces jointes

Hieu

XLDnaute Impliqué

Pièces jointes

philmaure

XLDnaute Impliqué

philmaure

XLDnaute Impliqué

gosselien

XLDnaute Barbatruc

Hieu

XLDnaute Impliqué

philmaure

XLDnaute Impliqué

philmaure

XLDnaute Impliqué

Hieu

XLDnaute Impliqué

philmaure

XLDnaute Impliqué

Discussions similaires