Sélectionner une liste dans une colonne et la reporter dans un autre fichier

**bentor22** · 25/01/2013, 23h41

Bonjour a tous,

J aimerai faire une macro qui me selectIonne les cellules d une colonne d un fichier nommé fichier 1, dans la feuille nommé feuille 1 colonne A et qu il me les colle dans un autre fichier nomme fichier 2, dans la feuille nommé feuille 2 dans la colonne B.

Également, j aimerai dans la feuille 1, colonne A qu il me sélectionne UNIQUEMENT les cellule qui ne sont pas en gras.

En vous remerciant d avance.

Cordialement

**Philippe Tulliez** · 26/01/2013, 09h41

Bonjour,
Voici déjà une réponse pour la première partie de ta question
Exemple de la copie de la colonne B de la feuille nommée db vers la colonne A de la feuille nommée Feuil1

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
Const column As Integer = 2 ' Numéro de la colonne à copier
Sub Test()
 Dim rngF As Range, rngT
 With ThisWorkbook
 Set rngF = .Worksheets("db").Range("A1").CurrentRegion
 Set rngT = .Worksheets("Feuil1").Range("A1")
 End With
 Set rngF = rngF.Offset(0, column - 1).Resize(, 1)
 rngF.Copy rngT
End Sub

Bonjour,
Réponse partielle à la deuxième partie (partielle parce-que tu obtiens la liste des cellules trouvées qui sont en gras).
Je suppose qu'avec la réponse à la première partie et celle-ci tu peux faire la copie.
Exemple de recherche dans la colonne B de la feuille nommée db des cellules qui sont en gras.

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 test2()
 Const column As Integer = 2 ' N° de colonne 
 Dim rngF As Range, myTable()
 Dim Elem As Long, txt As String
 With ThisWorkbook
 Set rngF = .Worksheets("db").Range("A1").CurrentRegion
 End With
 Set rngF = rngF.Offset(0, column - 1).Resize(, 1)
 myTable = SearchBold(rngF)
 If myTable(0) = False Then MsgBox "Pas trouvé ": Exit Sub
 txt = "Liste des adresses trouvées"
 With rngF
  For Elem = 1 To UBound(myTable)
   txt = txt & vbCrLf & .Cells(myTable(Elem), .column).Address
  Next
 End With
 MsgBox txt
End Sub

La fonction de recherche renvoie une table.

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
Function SearchBold(SearchArea As Range) As Variant
 Dim c As Range, firstAddress As String, count As Long
 Dim myTable()
 With Application.FindFormat
 .Clear
 .Font.Bold = True
 End With
 ReDim Preserve myTable(count): myTable(0) = False
 With SearchArea
  Set c = .Find(what:="", searchformat:=True)
  Select Case True
   Case Not c Is Nothing
    firstAddress = c.Address: count = count + 1
    ReDim Preserve myTable(count): myTable(0) = True: myTable(count) = c.Row
   Case Else: SearchBold = myTable: Exit Function
  End Select
  '
  Do
   Set c = .Find(what:="", after:=c, searchformat:=True)
  If Not c Is Nothing And c.Address <> firstAddress Then
   count = count + 1: ReDim Preserve myTable(count): myTable(count) = c.Row
  End If
  Loop While Not c Is Nothing And c.Address <> firstAddress
 
 End With
 SearchBold = myTable
End Function

**bentor22** · 26/01/2013, 10h59

Bonjour Philippe et merci de ta réponse,

Toutefois je pense m être mal exprimé,

Je reformule mon problème:

G une liste dans la colonne C d un fichier nomme : reporting 1 dans la feuille nommé: feuille 1.

De cette colonne, je ne veux sélectionner que les cellules qui ne sont pas en gras ET les copier dans un autre fichier qui se nomme:reporting mis a jour , dans la feuille nommé :feuille 3 dans la colonne A.

Merci d avance pour ton retour et ton aide précieuse.

Bien cordialement.

**Philippe Tulliez** · 26/01/2013, 11h21

Bonjour,
Une autre approche

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
Sub Test()
 Const column As Integer = 2
 Dim rngF As Range, myTable()
 Dim Elem As Long, txt As String
 With ThisWorkbook
 Set rngF = .Worksheets("db").Range("A1").CurrentRegion
 End With
 Set rngF = rngF.Offset(0, column - 1).Resize(, 1)
 myTable = SearchFormat(rngF)
 If myTable(0) = False Then MsgBox "Pas trouvé ": Exit Sub
 For Elem = 1 To UBound(myTable)
   txt = txt & vbCrLf & myTable(Elem)
 Next
 MsgBox txt
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Function SearchFormat(SearchArea As Range) As Variant
 Dim c As Range, R As Long, count As Long
 Dim myTable()
 ReDim Preserve myTable(count): myTable(0) = False
 For Each c In SearchArea
  If c.Font.Bold = False Then
   count = count + 1: ReDim Preserve myTable(count): myTable(count) = c.Address
  End If
 Next
 myTable(0) = UBound(myTable) > 1: SearchFormat = myTable
End Function

**bentor22** · 26/01/2013, 11h59

Bonjour et merci pour votre réponse.

Toutefois je ne vois pas comment vous différenciez les 2 fichiers car il y a le fichier reporting 1 d ou je copie mes données qui ne sont pas en gras pour les coller dans un autre fichier qui se nomme reporting mis a jour.

Merci d avance

**Philippe Tulliez** · 26/01/2013, 11h59

Bonjour,
Voici une autre version de la fonction qui renvoie un range et avec un argument facultatif qui prend l'étiquette de colonne.
La variable Objet rngF est le range à copier, rngT est le range de destination

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub test2()
 Const column As Integer = 2
 Dim rngF As Range, rngT As Range, myTable()
 Dim Elem As Long, txt As String
 With ThisWorkbook
  Set rngF = .Worksheets("db").Range("A1").CurrentRegion
  Set rngT = .Worksheets("Feuil1").Range("A1")
 End With
 Set rngF = rngF.Offset(0, column - 1).Resize(, 1)
 Set rngF = SearchFormat(rngF, False)
 If Not rngF Is Nothing Then rngF.Copy rngT
End Sub

La fonction qui renvoie un Range

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
Function SearchFormat(SearchArea As Range, Optional withLabel As Boolean = True) As Range
 ' Fonction qui renvoie un objet Range (toutes les cellules en gras)
 'Philippe Tulliez 26/01/2013
 'Arguments
 ' SearchArea : Range
 ' [WithLabel]: Boolean Si l'on souhaite que la fonction renvoie la première cellule [d:True]
 
 Dim c As Range, NewRange As Range, flag As Boolean
 For Each c In SearchArea
  If withLabel And flag = False Then Set NewRange = c: flag = True
  If c.Font.Bold = False Then
   Select Case flag
    Case False: Set NewRange = c: flag = True
    Case Else: Set NewRange = Application.Union(NewRange, c)
   End Select
  End If
 Next c
 Set SearchFormat = NewRange
End Function

**bentor22** · 26/01/2013, 12h23

Merci énormément.

Toutefois n est il pas mieux de mettre:

Set rngf=.workbooks(reporting1) .worksheets ect.......

**Philippe Tulliez** · 26/01/2013, 13h02

Bonjour,
Je t'ai donné un exemple de la copie d'une plage se trouvant sur une feuille et qui se colle sur une autre feuille du même classeur (ici ThisWorkBook) à toi de l'adapter.
Si le classeur n'est pas celui où se trouve le code VBA évidemment il faut modifier l'assignation de la variable objet.

**bentor22** · 26/01/2013, 15h45

Bonjour Philippe et merci de ta réponse,

Toutefois, j aimerai une fonction qui renvoie un objet range ( toutes les cellules qui ne sont pas en gras).

Dans la macro que tu as faites, il met tout les cellules qui sont en gras. Comment dois je ajuster la macro.

En te remerciant, encore une fois.

**Philippe Tulliez** · 26/01/2013, 15h56

Bonjour,
La dernière fonction que j'ai déposée à 11:59 renvoie un Range des cellules qui ne sont pas en gras

Code :

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

If c.Font.Bold = False Then

Si tu veux celles qui sont en gras il faut mettre la propriété Bold à True
La syntaxe est

Code :

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

1
2
 Set rngF = SearchFormat(rngF, False)
 If Not rngF Is Nothing Then rngF.Copy rngT

Ou

Code :

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

1
2
 Set rngF = SearchFormat(rngF)
 If Not rngF Is Nothing Then rngF.Copy rngT

Si tu souhaites avoir la première cellule (label) d'office qu'elle soit grasse ou pas

Bonjour,
On peut encore améliorer la fonction en ajoutant un argument facultatif qui permet de Copier/Coller les cellules qui sont en gras ou pas
L'argument ajouté est Bold qui est un Boolean avec comme valeur par défaut False
La syntaxe pour que la fonction renvoie un Range avec les cellules qui ne sont pas en gras

Code :

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

Set rngFrom = SearchFormat(rngFrom)

Avec les cellules en gras

Code :

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

Set rngFrom = SearchFormat(rngFrom, Bold:=True)

Nouvelle procédure

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
Function SearchFormat(SearchArea As Range, Optional withLabel As Boolean = True, Optional Bold As Boolean = False) As Range
 'SearchFormat(SearchArea As Range, Optional pBold As Boolean = True, Optional Color As Long, Optional withLabel As Boolean = True) as range
 ' Fonction qui renvoie un objet Range des cellules répondant à la condition de l'argument Bold
 'Philippe Tulliez 26/01/2013
 'Arguments
 ' SearchArea : Range
 ' [WithLabel]: Boolean Si l'on souhaite que la fonction renvoie la première cellule [d:True]
 ' [Bold] - Boolean True si on veut les cellules en gras, False (Defaut) si on veux celles qui ne sont pas en gras
 Dim c As Range, NewRange As Range, flag As Boolean
 For Each c In SearchArea
  If withLabel And flag = False Then Set NewRange = c: flag = True
  If c.Font.Bold = Bold Then
   Select Case flag
    Case False: Set NewRange = c: flag = True
    Case Else: Set NewRange = Application.Union(NewRange, c)
   End Select
  End If
 Next c
 Set SearchFormat = NewRange
End Function

**bentor22** · 28/01/2013, 10h09

Bonjour, et merci pour ton aide précieuse.

voici le code que j ai:

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
Sub test5()
'
' test5
'
 Dim str As String
 
 'Open the directory "C:\Syndication" to be able to find the correct report
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = "C:\Syndication"
    .Show
    'and select the report on which you click
    If .SelectedItems.Count > 0 Then Workbooks.Open (.SelectedItems(1))
End With
 
str = ActiveWorkbook.Name
 
 Const column As Integer = 4
'car je veux que les cellules copiés se mettent dans la colonne D
 Dim rngF As Range, rngT As Range, myTable()
 Dim Elem As Long, txt As String
  With Workbooks(str)
  Set rngF = .Worksheets("axe2").Range("D1").CurrentRegion
  End With
'les cellules que je copie
  With Workbooks("mise a jour 15 01 2013.xls")
  Set rngT = .Worksheets("base").Range("D3")
'je colle les cellules dans la colonne D
 End With
 Set rngF = rngF.Offset(0, column - 1).Resize(, 1)
 Set rngF = SearchFormat(rngF, False)
 If Not rngF Is Nothing Then rngF.Copy rngT
 
 'Et tu fermes ton classeur sans sauvegarder
Workbooks(str).Close SaveChanges:=False
 
End Sub
 
Function SearchFormat(SearchArea As Range, Optional withLabel As Boolean = True) As Range
 ' Fonction qui renvoie un objet Range (toutes les cellules en gras)
 'Arguments
 ' SearchArea : Range
 ' [WithLabel]: Boolean Si l'on souhaite que la fonction renvoie la première cellule [d:True]
 
 Dim c As Range, NewRange As Range, flag As Boolean
 For Each c In SearchArea
  If withLabel And flag = False Then Set NewRange = c: flag = True
  If c.Font.Bold = False Then
   Select Case flag
    Case False: Set NewRange = c: flag = True
    Case Else: Set NewRange = Application.Union(NewRange, c)
   End Select
  End If
 Next c
 Set SearchFormat = NewRange
End Function

J ai mis qques commentaires, pourrais tu me dire s ils sont exact?

Egalement dans le fichier ou je colle mes données, il y a déja des informations et je ne voudrai pas que la macro efface ces données mais juste qu ils se collent à la fin .

Merci encore une fois

en compilant ce code la, la macro ne marche pas, sauriez vous pourquoi?

**Philippe Tulliez** · 28/01/2013, 10h32

Bonjour,
Qu'est-ce qui ne marche pas ?
En lisant en vitesse ton code, je ne vois nulle part de code qui invoque la fonction SearchFormat mais je me trompe peut-être.

**bentor22** · 28/01/2013, 11h16

Tu as totalement raison, mais je ne sais pas ou integrer la fonction searchformat dans mon code

Code :

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

1
2
 Set rngF = rngF.Offset(0, column - 1).Resize(, 1)
 Set rngF = SearchFormat(rngF, False)

voici la fonction SearchFormat dans mon code

Bonjour Philippe,

pour resumer, la macro ne me copie pas les valeurs non gras demandés.
Il me semble qu il n'y a que le titre de la colonne D qui s efface.

Egalement, j aimerai rajouter dans ma macro, que les cellules copiés se collent à la fin de l'onglet car il y a déja des valeurs dans l onglet.

Encore une fois, merci par avance

**Philippe Tulliez** · 28/01/2013, 14h43

Bonjour,
J'explique à nouveau avec un exemple de copie vers une cellule (D1) se trouvant dans la feuille1 d'un classeur nommé Toto.xls

La fonction SearchFormat renvoie un objet Range qui représente les cellules ayant la propriété Bold à True ou False suivant l'argument Bold (valeur par défaut est True) que l'on passe à la fonction PLUS la première cellule de la colonne si l'argument WithLabel est à True (Qui est la valeur par défaut)
L'argument SearchArea DOIT être un objet Range d'une seule colonne.
Si l'on choisi les arguments par défaut, les arguments nommées peuvent MAIS ne doivent pas être passé.
Ainsi

Code :

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

Set rngFrom = SearchFormat(rngFrom, withLabel:=True, Bold:=False)

Ou

Code :

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

Set rngFrom = SearchFormat(rngFrom, Bold:=False)

Renverra la même plage puisque l'argument WithLabel a pour valeur par défaut True.

Le code et la fonction peuvent être dans le même module.
Le 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
Option Explicit
' Nom de la feuille d'origine (A tester)
Const shtFromName As String = "db"
' Nom du classeur et de la feuille cible
Const wkbTargetName As String = "Toto.xls", shtTargetName As String = "Feuil1"
Const Column As Integer = 3 ' N° de colonne à tester
Dim rngFrom As Range, shtTarget As Worksheet, rngTarget As Range
Sub Main()
 Init
 ' Réenitilaisation pour ne prendre que la colonne déterminée pas la constante Column
 Set rngFrom = rngFrom.Offset(0, Column - 1).Resize(, 1) ' Ne prend que la colonne concernée
 Set rngFrom = SearchFormat(rngFrom, withLabel:=True, Bold:=False)
 rngFrom.Copy rngTarget ' Copie des cellules sélectionnées vers la plage cible
End Sub
Sub Init()
 Set rngFrom = ThisWorkbook.Worksheets(shtFromName).Range("A1").CurrentRegion
 Set shtTarget = Workbooks(wkbTargetName).Worksheets(shtTargetName)
 Set rngTarget = shtTarget.Range("D1")
End Sub

La fonction SearchFormat

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
Function SearchFormat(SearchArea As Range, Optional withLabel As Boolean = True, Optional Bold As Boolean = False) As Range
 'SearchFormat(SearchArea As Range, Optional pBold As Boolean = True, Optional Color As Long, Optional withLabel As Boolean = True) as range
 ' Color et pBold à développer
 ' Fonction qui renvoie un objet Range, après test du format Bold (dépend de l'argument Bold
 'Author : Philippe Tulliez 26/01/2013
 'Version : v 1.1
 'Arguments
 ' SearchArea : Range (colonne à tester) ex Range("A2:A10")
 ' [WithLabel]: Boolean Si l'on souhaite que la fonction renvoie la première cellule [d:True]
 ' [Bold] - Boolean True (Defaut) si on veut les cellules en gras, False si on veux celles qui ne sont pas en gras
 Dim c As Range, NewRange As Range, flag As Boolean
 ' flag = Not withLabel
 For Each c In SearchArea
  If withLabel And flag = False Then Set NewRange = c: flag = True
  If c.Font.Bold = Bold Then
   Select Case flag
    Case False: Set NewRange = c: flag = True
    Case Else: Set NewRange = Application.Union(NewRange, c)
   End Select
  End If
 Next c
 Set SearchFormat = NewRange
End Function

Il est bien entendu que les valeurs par défaut des arguments optionnels peuvent être adaptées suivant ton cas.

J'espère que c'est maintenant plus clair. Sinon je peux envoyer un classeur exemple mais ce ne sera plus pour aujourd'hui.

[EDIT] Attention que le classeur cible doit être ouvert.
Tous fonctionne, je ne publie jamais un code que je n'ai pas testé.

**bentor22** · 28/01/2013, 15h41

Bonjour Philippe,

merci pour ta réponse, toutefois je suis débutant en VBA et j'ai du mal à saisir le tout.
Je me permets de réexpliquer la macro que je veux:

J'ai un fichier que j'ouvre, il s'appelle DT sur la feuille "base".

Grace au code suivant, j appelle un fichier ( qui est un fichier qui est actualisé hebdomadairement):

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim str As String
 
'Open the directory "S:\Syndication\Loan Syndication\SLOT\LoanTracker" to be able to find the correct report
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = "S:\Syndication\Loan Syndication\SLOT\LoanTracker"
    .Show
    'and select the report on which you click
    If .SelectedItems.Count > 0 Then Workbooks.Open (.SelectedItems(1))
End With
 
str = ActiveWorkbook.Name

Sur ce fichier la, sur l'onglet AS, je veux sélectionner les valeurs (uniquement sur la colonne D)qui ne sont pas en gras.
Ensuite, je veux coller ces valeurs dans le fichier DT (fichier initiale), sur la feuille "base", sur la colonne E (de préférence à la fin car il y a deja des données).

Encore une fois merci

**Philippe Tulliez** · 28/01/2013, 16h18

Bonjour,

Le contexte
Le site Developpez.com est un club d'entraide pour developpeur.
La plupart de ceux qui donne des réponses vivent de leurs connaissances en donnant des formations ou/et en développant. Je fais partie de ceux là.
Aider est une chose, faire le travail à la place des personnes qui posent des questions en est une autre.
Je suis nul en mécanique, le sujet ne m'intéresse guère et donc je fais appel à un spécialiste. C'est un choix que j'assume et je pense qu'en programmation c'est la même chose.
Petit historique perso
Il y a un peu plus de 20 ans, je savais juste faire une somme en Excel mais comme le sujet m'intéressait je me suis accroché et avec beaucoup de curiosités, du travail, de la persévérence je suis arrivé à la connaissance que j'ai aujourd'hui.
Il y a 15 ans, j'étais commercial et j'en avais marre de passer deux heures à faire une offre.
Je me suis dit qu'il devait y avoir un moyen d'automatiser tout cela et j'ai découvert un fantastique forum (à l'époque le MPFE) où j'ai rencontré des gens qui m'ont aidé. J'ai posé des dizaines de questions
Mon développement m'a prit un mois et en final je mettais 5 minutes pour faire cette offre (4 offres c'était une journée) avec un lien entre Excel et Word.
Conclusion
Pour développer même si on est amateur, cela demande du temps et beaucoup de travail.
Pour résumer mes propos, soit tu prends ton mal en patience, tu ouvres de nouveaux sujets en posant d'autres questions et tu finis par faire ce que tu souhaites soit tu fais appels à un spécialiste.
Le présent
La réponse que je t'ai donnée en développant une fonction qui renvoie un objet range avec en plus des arguments optionnels est du pratiquement tout fait. Mieux que cela c'est difficile.
Il te reste à faire des tests et à voir le résultat que cela renvoie.

Pour t'aider, le code que tu donnes renvoie dans la variable str le nom du classeur cible.
Dans le code que je t'ai donné c'est la constante wkbTargetName;

**bentor22** · 28/01/2013, 16h55

Bonjour Philippe,

ce que tu dis est parfaitement juste, c'est en prenant son mal en patience et en essayant de compiler qu'on appresnd le mieux.

C'est ce que j'essaie de faire grace à tes conseils et à ce que tu as pu coder.
Toutefois, je suis bien loin du résultat que je souhaite avoir.

C'est la raison pour laquelle je demande de l'aide en montrant exactement ce que je veux voir apparaitre en compilant ma macro.

Je débute en vba et grace à ce super forum, j'ai pu faire quelques macros simples.
en regardant les codes, j essaie de comprendre ce que tu as voulu faire et c'est ma methode d'apprentissage.

Sur cette macro la, je suis bloqué, car je la trouve compliquée.

Si tu pouvais me donner un coup de main, ce sera vraiment top.

Encore une fois merci du temps que tu m accordes.

**Philippe Tulliez** · 28/01/2013, 18h28

Bonjour,
Comme je l'ai écrit je pense que sur cette question particulière j'ai été on ne peut plus loin en te livrant une fonction prête à l'emploi et en t'expliquant avec un exemple comment l'utiliser.
Si tu as d'autres questions ou sujets que tu ne comprends pas, tu ouvres une ou plusieurs nouvelles discussions en posant de nouvelles questions.
C'est la seule manière d'y arriver et de respecter la charte de ce forum.

**bentor22** · 29/01/2013, 13h54

Bonjour Philippe, tu as totalement raison dans ce que tu dis.
j'essaie sans cesse de reussir à compiler.

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
Sub Commonname()
'
' Commonname Macro
' Macro enregistrée le 29/01/2013 par moi
Dim str As String
 
'Open the directory "S:\Syndication\" to be able to find the correct report
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = "S:\Syndication\"
    .Show
    'and select the report on which you click
    If .SelectedItems.count > 0 Then Workbooks.Open (.SelectedItems(1))
End With
 
str = ActiveWorkbook.Name
'
Option Explicit
' Nom de la feuille d'origine (A tester)
Const shtFromName As String = "base"
' Nom du classeur et de la feuille cible
Const wkbTargetName As String = str, shtTargetName As String = "as"
Const Column As Integer = 4 ' N° de colonne à tester
Dim rngFrom As Range, shtTarget As Worksheet, rngTarget As Range
 Init
 ' Réenitilaisation pour ne prendre que la colonne déterminée pas la constante Column
 Set rngFrom = rngFrom.Offset(0, Column - 1).Resize(, 1) ' Ne prend que la colonne concernée
 Set rngFrom = SearchFormat(rngFrom, withLabel:=True, Bold:=False)
 rngFrom.Copy rngTarget ' Copie des cellules sélectionnées vers la plage cible
 Set rngFrom = ThisWorkbook.Worksheets("base").Range("D1").CurrentRegion
 Set shtTarget = Workbooks(str).Worksheets("as")
 Set rngTarget = shtTarget.Range("D1")
End Sub
 
Function SearchFormat(SearchArea As Range, Optional withLabel As Boolean = True, Optional Bold As Boolean = False) As Range
 'SearchFormat(SearchArea As Range, Optional pBold As Boolean = True, Optional Color As Long, Optional withLabel As Boolean = True) as range
 ' Color et pBold à développer
 ' Fonction qui renvoie un objet Range, après test du format Bold (dépend de l'argument Bold
 'Author : Philippe Tulliez 26/01/2013
 'Version : v 1.1
 'Arguments
 ' SearchArea : Range (colonne à tester) ex Range("A2:A10")
 ' [WithLabel]: Boolean Si l'on souhaite que la fonction renvoie la première cellule [d:True]
 ' [Bold] - Boolean True (Defaut) si on veut les cellules en gras, False si on veux celles qui ne sont pas en gras
 Dim c As Range, NewRange As Range, flag As Boolean
 ' flag = Not withLabel
 For Each c In SearchArea
  If withLabel And flag = False Then Set NewRange = c: flag = True
  If c.Font.Bold = Bold Then
   Select Case flag
    Case False: Set NewRange = c: flag = True
    Case Else: Set NewRange = Application.Union(NewRange, c)
   End Select
  End If
 Next c
 Set SearchFormat = NewRange
End Function
'
End Function

Il y a plusieurs chose que je ne comprends:
- le option explicit peut il etre en dehors d un sub?
- comment puis je definir mon str=workbookactive.name sachant que le fichier d ou je prends mes valeurs est actualisé hebdomadairement.
- pourquoi as tu plusieurs sub, peut on tout mettre dans la meme macro?

Merci encore une fois, j ai besoin de toi

petite specificité, je travaille sous excel 2003

**Philippe Tulliez** · 29/01/2013, 14h22

Bonjour,

Envoyé par bentor22

Bonjour Philippe, tu as totalement raison dans ce que tu dis.
j'essaie sans cesse de reussir à compiler.

Déjà j'aimerais savoir ce que tu entends par compiler parce-que tu utilises ce termes chaque fois or on ne compile pas le VBA, c'est un intérpreteur.
Dans le VBE, Compiler le VbaProject permet de détecter certaines erreurs de syntaxes, déclaration etc...

Il y a plusieurs chose que je ne comprends:
- le option explicit peut il etre en dehors d un sub?

Option Explicit est une option qui doit être placée en début de Module qui indique au VBA que toutes les variables doivent être déclarées. Ce n'est pas obligatoire mais pour moi c'est absolument indispensable pour programmer proprement et surtout efficacement.

- comment puis je definir mon str=workbookactive.name sachant que le fichier d ou je prends mes valeurs est actualisé hebdomadairement.

En VBA, on affecte les variables par cette syntaxe maVariable = maValeur sauf pour les variables objets qui doivent être précédée de la commande SET, par exemple SET maVariableObjet = Objet (le classeur, la feuille, les cellules sont des objets).

- pourquoi as tu plusieurs sub, peut on tout mettre dans la meme macro?

Ce n'est pas obligatoire mais moi je découpe toujours les différents stades de mon projet.
C'est plus efficace en maintenance et en lecture des procédures, parce-que quand une procédure est bien programmée et fonctionne on la place dans n'importe quel projet d'une façon transparente.
Ainsi la fonction SearchFormat je peux la réutilisée dans des dizaines de projets, il me suffit de lui passer les bons paramètres. Quand tu utilises l'explorateur Windows pour chercher un fichier Excel ou Word, ou MP3 c'est une même procédure qui possède plusieurs arguments. La plupart des fonctions Excel sont des procédures avec plusieurs arguments qui peuvent donner des résultats différents suivants les arguments passés.
Même l'initialisation de mes variables globales je la place dans une procédure indépendantes, ainsi quand je démarre un nouveau projet les variables classeurs, feuilles etc.. sont déjà pré-déclarées, et prête à l'emploi. Je dois juste changer leurs noms.
Si tu as envie de vraiment programmé en VBA, je te conseille la lecture de quelques tutos super bien fait et présent sur ce site.
Mais avant pour programmer efficacement en VBA pour Exel, il faut une bonne connaissance des formules et des outils qu'offre Excel. Soit parce-que l'on se rend compte que l'on réinvente de l'existant soit parce-que l'on peut ecrire en cinq, six lignes une procédure que d'autres écriront en une centaine de lignes par méconnaissance du produit.

Sélectionner une liste dans une colonne et la reporter dans un autre fichier

Macros et VBA Excel

Discussions similaires

Partager

Partager