décalage a droite

claude09

XLDnaute Occasionnel
Bonjour.J'ai une macro qui actualise des données qui se mettent en c2:c20.Il faudrait qu'a la prochaine actualisation,les données se mettent en d2:d20,et décaler d'une colonne a chaque actualisation.
Merci de vos réponses.
 

ERIC S

XLDnaute Barbatruc
Bonjour

c'est mieux avec un fichier

dercol = Cells(2, Columns.Count).End(xlToLeft).Column
cells(2, dercol+1).value = ….
Cells(3, dercol+1).value=...

dercol te donne la dernière colonne de la ligne
cells écrit en incrémentant la colonne
 

job75

XLDnaute Barbatruc
Bonjour claude09, ERIC S, Patrice33740,

@ ERIC S : dans la feuille de destination des cellules en ligne 2 peuvent être vides...

Voyez le fichier joint et cette macro :
Code:
Sub Transfert()
Dim F1 As Worksheet, F2 As Worksheet, dest As Range, col%
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames des feuilles source et destination
Set dest = F2.[2:20] 'lignes entières
If dest(1) = "" Then dest(1) = " " 'au cas où dest est vide
col = dest.Find("*", , xlValues, , xlByColumns, xlPrevious).Column + 1
If col < 3 Then col = 3
F1.[A2].Resize(dest.Rows.Count).Copy dest.Columns(col) 'copier-coller
F2.Activate
End Sub
A+
 

Pièces jointes

  • Transfert(1).xlsm
    23.1 KB · Affichages: 29

claude09

XLDnaute Occasionnel
Merci de vos réponses.
Voici le code de la macro.
Sub Turf()
Dim ScriptControl As Object, PMU As Object
Dim Ecurie As Object, Cheval As Object, Drd As Object, Gp As Object
Dim Site As String, i As Long

Set ScriptControl = CreateObject("MSScriptControl.ScriptControl")
ScriptControl.Language = "JScript"

Site = "https://offline.turfinfo.api.pmu.fr/rest/client/7/programme/01122018/R1/C5/participants"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Site, False
.send
Set PMU = ScriptControl.Eval("(" + .responseText + ")")
.abort
End With

i = 2
Set Ecurie = PMU.participants
On Error Resume Next
For Each Cheval In Ecurie
With ActiveSheet
.Cells(i, 1).Value = Cheval.numPmu
.Cells(i, 2).Value = Cheval.nom
Set Drd = Cheval.dernierRapportDirect
.Cells(i, 3).Value = Drd.rapport

i = i + 1
End With

Next Cheval

Set Drd = Nothing
Set Gp = Nothing
Set Ecurie = Nothing
Set PMU = Nothing
Set ScriptControl = Nothing



End Sub
Merci
 

job75

XLDnaute Barbatruc
Re,

Voyez ce fichier (2) et cette macro :
Code:
Sub Transfert()
Dim F1 As Worksheet, F2 As Worksheet, dest As Range, col%
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames des feuilles source et destination
'---transfert des colonnes A et B---
F1.Columns("A:B").Copy F2.[A1]
'---transfert de la colonne C---
Set dest = F2.[2:20] 'lignes entières
If dest(1) = "" Then dest(1) = " " 'au cas où dest est vide
col = dest.Find("*", , xlValues, , xlByColumns, xlPrevious).Column + 1
If col < 3 Then col = 3
F1.[C2].Resize(dest.Rows.Count).Copy dest.Columns(col) 'copier-coller
F2.Activate
End Sub
A+
 

Pièces jointes

  • Transfert(2).xlsm
    26.5 KB · Affichages: 66

Discussions similaires

Réponses
4
Affichages
277
Réponses
4
Affichages
156