Discussion :

[FloLLM]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

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......

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[pijaku]

Bonjour,

Voyons si j'ai compris...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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...

[Invité]

Bonjour Franck,

Je vais plutôt aller me coucher....

[FloLLM]

Hello,

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