Correction Loop dans une macro (insertion décalage à chaque loop)

Version imprimable

Bonjour,

je souhaite créer une macro qui récupère les données (en valeur) de plusieurs onglets (même trame) a partir du 14ème onglet jusqu’à la fin du fichier et les copie sur une feuille appelée "BDD".

J'ai commencé par créer la macro sur un seul onglet afin d'avoir une base de travail mais je ne parvient pas à créer une boucle correcte ( les donnée des onglets suivants viennent écraser celles du premier onglet).

l'objectif : les données du premier onglet source sont collées en valeur dans BDD sur la plage A2:28, le second devrait aller à la suite en A29:M55 et ainsi des suite.

Merci d'avance pour votre aide :)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub Recap_Prod() Dim i As Long, ldest As Long Worksheets("BDD").Select Cells.Delete For i = 13 To Worksheets.Count With Worksheets(i) Range("A2:A28").Value = .Range("N1").Value Range("B2:B28").Value = .Range("N2").Value Range("C2:M28").Value = .Range("A7:M33").Value End With Next ldest = ldest + 1 End Sub

Citation:

Envoyé par FloLLM

Bonjour,

Votre énoncé n'est pas suffisamment clair. L'aboutissement des colonnes A et B est la colonne N dans l'onglet BDD, on pourrait supposer dans ce cas que les copies se superposent par rapport à la colonne N, mais vient après la copie de l'aire C2:M28 qui est décalée dans BDD......:calim2:

Le code ci-dessous est une adaptation tout à fait libre de votre code avec copie de zones de dimensions homogènes sur 27 lignes. Dans ce code la colonne de destination est la colonne L et non N pour éviter les 2 colonnes vides (L et M). Il vous suffira d'adapter le code si nécessaire :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Sub Recap_Prod_EK() Dim I As Integer, Ldest As Integer, PremierOnglet As Integer Dim ShBdd As Worksheet Set ShBdd = Worksheets("BDD") ShBdd.UsedRange.Cells.Clear Ldest = 2 PremierOnglet = 13 If PremierOnglet > Worksheets.Count Then MsgBox "Le nombre d'onglets est de " & Worksheets.Count, vbCritical, "C'était bien joué, mais pas de pot !" Exit Sub End If With Worksheets(PremierOnglet) .Range("A1:B1").Copy Destination:=ShBdd.Range("L1") .Range("C1:M1").Copy Destination:=ShBdd.Range("A1") End With For I = PremierOnglet To Worksheets.Count With Worksheets(I) .Range("A2:B28").Copy Destination:=ShBdd.Range("L" & Ldest) .Range("C2:M28").Copy Destination:=ShBdd.Range("A" & Ldest) Ldest = Ldest + 27 End With Next Set ShBdd = Nothing End Sub

18/09/2018, 07h47
FloLLM
Bonjour Eric,

Merci pour votre message et votre aide.

Je viens de modifier l’énoncé est espère qu'il sera plus clair.

Cette partie fonctionne correctement :
Code:

1 2 3 Range("A2:A28").Value = .Range("N1").Value Range("B2:B28").Value = .Range("N2").Value Range("C2:M28").Value = .Range("A7:M33").Value
Ce qui "bug" c'est qu'il n'existe aucun décalage d'une ligne lors de la copie des onglets suivants. Idéalement : 1er onglet = copie valeur sur BDD A2:M28 ; 2ème = sur BDD A29:M55, 3ème = A56.... etc

Bonne journée :)

Bonjour,

Voyons si j'ai compris...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Recap_Prod()
Dim i As Long, ldest As Long, lfinPlage As Long
Worksheets("BDD").Select
Cells.Delete
ldest = 2
lfinPlage = ldest + 26
For i = 13 To Worksheets.Count
   With Worksheets(i)
      Range("A" & ldest & ":A" & lfinPlage).Value = .Range("N1").Value
      Range("B" & ldest & ":B" & lfinPlage).Value = .Range("N2").Value
      Range("C" & ldest & ":M" & lfinPlage).Value = .Range("A7:M33").Value
   End With
   ldest = ldest + 27
   lfinPlage = ldest + 26
Next
 
End Sub

Citation:

Envoyé par FloLLM

Le décalage présent dans ma première réponse correspond à ce que vous souhaitez.

Sinon, s'il faut ramener les copies à partir de la colonne A de BDD :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Sub Recap_Prod_EK_V2()
 
Dim I As Integer, Ldest As Integer, PremierOnglet As Integer
Dim ShBdd As Worksheet
 
    Set ShBdd = Worksheets("BDD")
 
    ShBdd.UsedRange.Cells.Clear
    Ldest = 2
    PremierOnglet = 13
 
    If PremierOnglet > Worksheets.Count Then
       MsgBox "Le nombre d'onglets est de " & Worksheets.Count, vbCritical
       Exit Sub
    End If
 
    'With Worksheets(PremierOnglet)
    '     .Range("A1:M1").Copy Destination:=ShBdd.Range("A1")
    'End With
 
 
    For I = PremierOnglet To Worksheets.Count
        With Worksheets(I)
             .Range("A2:M28").Copy Destination:=ShBdd.Range("A" & Ldest)
             Ldest = Ldest + 27
        End With
    Next
 
    Set ShBdd = Nothing
 
End Sub

18/09/2018, 08h32
pijaku

Salut Eric,

Un p'tit café? :)

Tu as raison pour le décalage, mais...
Il ne veut pas ramener A2:M28, mais N1, N2 et A7:M33...
18/09/2018, 08h44
Invité

Citation:

Envoyé par pijaku

Bonjour Franck,

Je vais plutôt aller me coucher....:arf:
18/09/2018, 19h41
FloLLM

Hello,

Merci pour vos réponses, tout est résolu :)