Discussion :

[Pagaille]

Bonjour à tous,

Apparemment le sujet est déjà résolu sur ce forum mais n'étant pas un AS du VBA, je ne peux l'adapter à mon problème que voici:

Je voudrais copier des plages de données contenues dans des tableaux identiques, dans des feuilles différentes, pour créer un tableau de synthèse.

En réalité ces tableaux me sont envoyés par mail et moi je les enregistre à la date à la quelle ils sont générés.

Voici mes contraintes:

1. Le classeur ne contient pas que des feuilles à copier,la macro devra peut être éviter certaines feuilles.

2. Je voudrais copier seulement des colonnes bien précises et surtout avoir la possibilité de modifier les N° des colonnes à copier ( parce qu'il arrive que l'on ajoute certaines colonnes pour des besoins spécifiques)

3. Les noms des feuilles doivent me servir de référence de la feuille source par ce que ce sont en fait des dates (format xx-xx-xx, car xx/xx/xx impossible). "NB: dans les feuilles sources il n'y pas de colonne date du jour c'est le nom de la feuille qui servira de date sur chaque ligne copiée"

4. Le nombre de ligne est variable

5. Le fichier de synthèse n'est pas forcement au même endroit il peut être au début, au milieu ou à la fin du fichier

6. Les feuilles à copier aussi ne sont pas toujours alignés en fonction des dates( qui sont ici leurs noms) mais ça c'est pas trop grave car un filtre ou le TCD va gérer.

7. En fin, il ne doit pas répéter la ligne du haut (en tête).

J'espère avoir été claire, alors si quelqu'un peut m'aider, je serais plus que heureux

Merci d'avance et je peux joindre le fichier sur le quel je travail au cas où ce serait nécessaire.

[BDA53]

Salut

Pour répondre à ta question, tu peux utiliser ce code.

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
 
Sub Synthese()
    Dim i As Integer
    Dim j As Integer
    Dim feuille As Boolean
    'Pour le 3) tu peux déclarer le nom de ta feuille avec dim wb as worksheet = "Feuil1"
    'Du coup worksheets(i) devient wb
 
    For i = 1 To 20 ' Boucle pour les feuilles de calcul
        If Worksheets(i).Cells(i, 1) Is Empty Then feuille = False 'Test si la feuille est vide, feuille reçoit la valeur  false
        If feuille = False Then Exit Sub 'si feuille est égal à false alors on ne fait rien, on sort de la procédure
        'l'indice démarre à 2 pour ne pas prendre l'entête
        For j = 2 To Worksheets(1).Range.End(xlDown).Row 'XlDown.Row permet d'obtenir l'indice de la dernière ligne contenant des données
            Worksheets(5).Cells(j, 2) = Worksheets(i).Cells(j, 1) 'Exemple de copie des cellules
            Worksheets(5).Cells(j, 3) = Worksheets(i).Cells(j, 2) 'La feuille choisie reçoit les valeurs de la i-ème table
        Next j ' A toi de choisir l'endroit où tu veux placer ta feuille
    Next i 'Si tu veux le faire aléatoirement utilise la fonction Rnd()
 
End Sub

Cordialement,

xela57

[Pagaille]

Bonjour XELA57, merci pour ton poste qui m'a été d'une grande utilité.

Je l'ai testé avec quelques adaptations, il marche mais ne fait pas ce que je veux exactement. Du coup j'ai décidé de le modifier mais je n'arrive pas faire éviter plusieurs feuilles dans la boucle FOR du genre if sheets(i).name<> "RECAP" et " STOCK" et "...."

Voici mon code

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
35
36
37
38
39
40
41
42
43
44
45
46
47
 
 
Option Explicit
Dim i As Integer, j As Integer, k As Integer, lr As Integer, derligne As Integer, lastR As Integer
Sub effacer()
Sheets("RECAP").Select
Rows("2:100000").Select
Selection.Delete shift:=xlUp
Range("A2").Select
 
 
End Sub
 
 
Sub générer()
Application.ScreenUpdating = False
effacer
For j = 1 To Sheets.Count
Sheets(j).Select
derligne = Range("A100000").End(xlUp).Row
For i = 2 To derligne
If Sheets(j).Name <> "RECAP" Then
Sheets(j).Select
Union(Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 5), Cells(i, 6), Cells(i, 11), Cells(i, 15), Cells(i, 17), Cells(i, 27)).Select
Selection.Copy
Sheets("RECAP").Select
lr = Range("A100000").End(xlUp).Row + 1
Cells(lr, 1).Select
ActiveSheet.Paste
Sheets("RECAP").Cells(lr, 10) = Sheets(j).Name
With Sheets("RECAP").Cells(lr, 10)
   .Value = CDate(.Value)
   .NumberFormat = "dd/mm/yyyy"
End With
Application.CutCopyMode = False
 
 
End If
 
 
Next i
 
 
Next j
 
 
End Sub

[BDA53]

Déjà voici un conseil qui t'aidera beaucoup :

Quand tu as une nouvelle boucle ou une procédure, n'oublie jamais de tabuler et de passer à la ligne.
Cela rend ton code plus lisible, plus structurée et de plus il te permet de le lire bien plus rapidement
De plus il y a quelques erreurs dedans :
-Il faut toujours mettre call pour appeller une procédure.
-les variables hors procédure sont des constantes et doivent avoir comme mot clé Public Const.
-Il est mieux de mettre Cells à la place de Range car tu n'as qu'une cellule et de commencer ton End(xlup).Row à A2

Cela donne ça avec ton code :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
Option Explicit
 
Public Const i As Integer, j As Integer, k As Integer, lr As Integer, derligne As Integer, lastR As Integer
 
Sub effacer()
  Sheets("RECAP").Select
  Rows("2:100000").Select
  Selection.Delete shift:=xlUp
  Range("A2").Select
 
 
End Sub
 
 
Sub générer()
 
  Application.ScreenUpdating = False
  Call effacer
  For j = 1 To Sheets.Count
    Sheets(j).Select
    derligne = Worksheets(j).Cells(2,1).End(xlUp).Row
    For i = 2 To derligne
       If Sheets(j).Name <> "RECAP" Then
          Sheets(j).Select
          Union(Cells(i, 1), Cells(i, 2), Cells(i, 3), Cells(i, 5), Cells(i, 6), Cells(i, 11), Cells(i, 15), Cells(i, 17), Cells(i, 27)).Select
          Selection.Copy
          Sheets("RECAP").Select
          lr = Worksheets(j).Cells(2,1).End(xlUp).Row + 1
          Cells(lr, 1).Select
          ActiveSheet.Paste
          Sheets("RECAP").Cells(lr, 10) = Sheets(j).Name
          With Sheets("RECAP").Cells(lr, 10)
             .Value = CDate(.Value)
             .NumberFormat = "dd/mm/yyyy"
          End With
          Application.CutCopyMode = False
 
 
      End If
 
 
      Next i
 
 
   Next j
 
 
End Sub

[kiki29]

Salut, call ne sert strictement plus à rien depuis très longtemps
Utiliser SmartIndenter
etc etc

[BDA53]

Merci pour cette information kiki.

Alors la je suis sur le cul, nos profs de programmation nous apprennent à appeler des procédures avec Call alors qu'on ne l'utilise plus depuis très longtemps.