Discussion :

[cline01]

Bonjour,

Je dois, chaque mois, à partir d'un fichier, transférer sur d'autres feuilles des données en fonction de critères. Je souhaiterais ainsi créer une macro afin d'automatiser ce process.

Concrètement j'ai une feuille dont le titre est de type "Données [mois] 2009" (j'ai un fichier pour chaque mois: "Données mai 2009" , "Données juin 2009"...) et qui contient des informations sur des clients.
A chaque fois que j'exécute la macro, je souhaiterais, par exemple copier les données des clients vivant à Marseille, Bordeaux ou Nice dans une feuille nommée "REGION SUD" que j'aurai crée et en ayant copié les titres des colonnes de ma feuille "Données [mois] 2009". Et pour vérifier que tout est pris, je voudrais colorer la ligne qui correspond à ma condition.

J'ai tenté certaines choses mais elles ne fonctionnent pas:

1) Je voulais créé une procédure permettant de créer mes onglets et recopier les titres des colonnes de mon fichier source:

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
Sub InsereFeuille()
    Classeur = ActiveWorkbook.Name
    Workbooks(Classeur).Activate
 
    mois = InputBox("Mois des données?") 
 
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "IDF"
 
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "REGION SUD"
 
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "REGION NORD"
 
    Worksheets("BL Clients GS &mois&2010").Activate 'ne marche pas
    Range(Cells(1, 1), Cells(1, 1).End(xlRight)).Copy 'copie des titres de la feuille
 
    For Each feuille In Worksheets
        If feuille.Name <> "BL Clients GS &mois&2010" Then
            feuille.Range("A1").PasteSpecial
        End If
 
    Next feuille
 
End Sub

-> Sur cette procédure, ma variable "mois", même avec un espace, ne s'ajoute pas au titre et donc m'empêche de reproduire mes titres


2) Ensuite, je pensais créer une autre procédure où je stockerais dans une table es données correspondant aux villes désirées puis de copier cette table dans la feuille correspondant à la bonne région. Ce que j'ai fait est un peu confus et je me demande s'il ne faut pas faire une fonction:

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
Sub Remplir()
    Call InsereFeuille
    Worksheets("BL Clients GS &mois& 2010").Activate
    ReDim Table_IledeF(j, 1) As Double
    ReDim Table_Nord(j, 1) As Double
    ReDim Table_Sud(j, 1) As Double
 
    n = Range(Cells(2, 1), Cells(2, 1).End(xlDown))
 
    j = 1
        For i = 2 To n
        If Cells(i, 3).Value = "PARIS" Or "VERSAILLES" Or "PANTIN" Then
        Table_IledeF(j, 1) = Range(Cells(i, 1), Cells(i, 1).End(xlToRight))
        Range(Cells(i, 1), Cells(i, 1).End(xlToRight)).Interior.Color = vbRed
 
        ElseIf Cells(i, 3).Value = "LENS" Or "LILLE" Then
        Table_Nord(j, 1) = Range(Cells(i, 1), Cells(i, 1).End(xlRight))
        Range(Cells(i, 1), Cells(i, 1).End(xlToRight)).Interior.Color = vbGreen
 
        ElseIf Cells(i, 3).Value = "BORDEAUX" Or "MARSEILLE" Or "NICE" Then
        Table_Sud(j, 1) = Range(Cells(i, 1), Cells(i, 1).End(xlRight))
        Range(Cells(i, 1), Cells(i, 1).End(xlToRight)).Interior.Color = vbBlue
 
        j = j + 1
        End If
        Next i
 
    Worksheets("IDF").Activate
    y = UBound(Table_IDF)
    x = LBound(Table_IDF)
    Range(Cells(2, 1), Cells(x, y)).Value = Table_IledeF
 
    Worksheets("REGION SUD").Activate
    y = UBound(Table_Sud)
    x = LBound(Table_Sud)
    Range(Cells(2, 1), Cells(x, y)).Value = Table_Sud
 
    Worksheets("REGION NORD").Activate
    y = UBound(Table_Nord)
    x = LBound(Table_Nord)
    Range(Cells(2, 1), Cells(x, y)).Value = Table_Nord
End Sub

-> Sur cette procédure, je n'arrive pas à dimensionner ma table, et je ne sais pas si je peux stocker de cette manière.

Merci d'avance pour votre aide

[mercatog]

Le mieux est de piloter le code à partir d'un fichier maître en procédant à l'ouverture du fichier en question et de procéder aux dispaching des données par région.
le fichier à traiter est ouvert soit à l'aide de l'explorateur windows ou en entrant son nom et chemin.
Dans le fichier maître, on va incorporer un tableau de correspondance entre ville et région.

Edit:
Ci-joint proposition
Fichier Maître:
Feuille1 nommée CARTE en colonne A: nom des villes, en colonne B: régions correspondantes
Feuillle2 nommée MENU: en A1: Fichier traité, en B1: Date, Bouton de commande

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
50
51
52
53
54
55
56
57
58
59
60
61
Option Explicit
Private Sub CommandButton1_Click()
Dim awbk As Workbook, wbk As Workbook
Dim shtv As Worksheet, shtn As Worksheet, sht As Worksheet
Dim Fich As Variant
Dim LastLig As Long, i As Long
Dim c As Range
Dim Reg As New Collection
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Set awbk = ThisWorkbook
Set shtv = awbk.Sheets("CARTE")
Fich = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Fich <> False Then
   Set wbk = Workbooks.Open(Fich)
   Set sht = wbk.Sheets(1)
   With sht
      LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
      For i = 2 To LastLig
         Set c = shtv.Columns("A:A").Find(.Range("C" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then .Cells(i, Columns.Count).Value = c.Offset(0, 1).Value
            On Error Resume Next
               Reg.Add c.Offset(0, 1).Value, c.Offset(0, 1).Value
            On Error GoTo 0
          Set c = Nothing
     Next i
         For i = 1 To Reg.Count
            If .FilterMode Then .ShowAllData
            On Error Resume Next
               Sheets(Reg(i)).Delete
            On Error GoTo 0
            Set shtn = wbk.Sheets.Add
               shtn.Move after:=wbk.Worksheets(wbk.Worksheets.Count)
               shtn.Name = Reg(i)
               With .Range(.Cells(1, Columns.Count), .Cells(LastLig, Columns.Count))
                  .AutoFilter field:=1, Criteria1:=Reg(i)
                  With .SpecialCells(xlCellTypeVisible)
                     .ClearContents
                     .EntireRow.Copy shtn.Range("A1")
                     .EntireRow.Interior.ColorIndex = 30 + i
                  End With
               End With
               If .FilterMode Then .ShowAllData
            Set shtn = Nothing
         Next i
   End With
   With awbk.Sheets("MENU")
      .Rows(2).Insert
      .Range("A2").Value = wbk.FullName
      .Range("B2").Value = Now
   End With
   Set sht = Nothing
   Set shtv = Nothing
   Set awbk = Nothing
   wbk.Save
   wbk.Close
   Set wbk = Nothing
End If
End Sub