Copie d'onglets s'ils existent deja dans ma feuille

[Spiekermayo]

Bonjour tout le monde,


Je n'arrive pas a faire tourner ce code pour qu'il me copie tous les onglets deja existants dans ma feuille.


J'essaie de creer une macro pour que mes onglets se remplissent automatiquement en fonction d'une cellule.

En gros :

NbF = Application.WorksheetFunction.CountA(.Range("H:H"))

For i = 1 To NbF


Mon sheet1 est un tableau de valeur, j'ai egalement une dizaine d'autres onglets preremplis.

Si Sheets(1).Cells(i,8).Value est egale au nom d'un de mes onglets, alors l'onglet en question prend Sheets(1).Cells(i,1) , Sheets(1).Cells(i,2) , Sheets(1).Cells(i,4) qu'il se colle dans 3 cellules chez lui ( G1, I1, G3).


Mon probleme:

Mes noms d'onglets vont correspondre avec plusieurs Sheets(1).Cells(i,8).Value

Pour l'instant, mon premier onglet se copie bien le nombre de fois qu'il rencontre une analogie avec Sheets(1).Cells(i,8).Value. ( cependant il se copie dans d'autres nouveaux classeurs et pas dans mon classseur initial....)


Mais le code ne copie pas les autres onglets qui ont eux aussi plusieurs analogies, c'est donc sur ce point que je bloque je n'arrive a passer a mon Sheets(1).Cells(i,8).Value suivant.


J'ai laisse mon code actuel ci-dessous, si vous avez une jeune piste a exploiter ca m'aiderait bien...



Bonne journee a tous.





Sub add_sheets()


Dim NbF As Long, i As Long, Nf As String

With Sheets(1)

NbF = Application.WorksheetFunction.CountA(.Range("H:H"))

For i = 1 To NbF

On Error Resume Next

Nf = .Cells(i, 8).Value
Sheets(Nf).Range("G1") = .Cells(i, 1)
Sheets(Nf).Range("I1") = .Cells(i, 2)
Sheets(Nf).Range("G3") = .Cells(i, 4)

Next

For i = 1 To NbF

On Error Resume Next

If Nf = .Cells(i, 8).Value Then

Sheets(Nf).Copy
Sheets(Nf).Range("G1") = .Cells(i, 1)
Sheets(Nf).Range("I1") = .Cells(i, 2)
Sheets(Nf).Range("G3") = .Cells(i, 4)


End If


Next

End With

End Sub

 

[youky(BJ)]

Re : Copie d'onglets s'ils existent deja dans ma feuille

Salut,
Les explications sont dur à comprendre sans fichier exemple
Donc j'ai fait avec ce que j'ai compris !
Bruno

Sub add_sheets()
nbf = Sheets.Count 'nbre onglets
For onglet = 1 To nbf
'on recherche par onglet si son nom est présent en H
lig = Application.Match(Sheets(onglet).Name, [H:H], 0)
If Not IsError(lig) Then 'si la ligne est trouvée
  Sheets(onglet).Copy After:=Sheets(Sheets.Count)
[G1] = Sheets(1).Cells(lig, 1)
[I1] = Sheets(1).Cells(lig, 2)
[G3] = Sheets(1).Cells(lig, 4)
End If
Next
End Sub

 

[Spiekermayo]

Re : Copie d'onglets s'ils existent deja dans ma feuille

Salut Bruno,


Merci pour tes explications, c'est vrai que la description de mon probleme n'etait pas vraiment en francais....

Je t'ai joins un petit fichier, je pense que tu cerneras mieux mon soucis si tu as encore un instant a y consacrer.

Tu verras ma macro dans le Module 8.

En la faisant tourner tu remarqueras que seul mon onglet "2-P-001" est copie et rempli automatiquement, j'aimerai qu'il en soit de meme pour mes onglets "1-P-001" et "3-P-001".


Merci pour ton aide et ton premier code

 

[youky(BJ)]

Re : Copie d'onglets s'ils existent deja dans ma feuille

Essaie à nouveau le fichier
Macro add_ modifiée
Le tout si j'ai pigé la demande
Bruno

Sub add_sheets()
Dim NbF As Long, i As Long, Nf As String, c
With Sheets(1)
On Error Resume Next
 For Each c In .Range("H2:H" & .[H65000].End(3).Row)
  If c <> "" Then
   Sheets(c.Text).Copy After:=Sheets(Sheets.Count)
    If Err > 0 Then
      MsgBox "Impossible de copier " & c.Value, vbExclamation: Err.Clear
    Else
     ActiveSheet.[G1] = .Cells(c.Row, 1)
     ActiveSheet.[I1] = .Cells(c.Row, 2)
     ActiveSheet.[G3] = .Cells(c.Row, 4)
    End If
  End If
 Next
End With
End Sub

 

[Spiekermayo]

Re : Copie d'onglets s'ils existent deja dans ma feuille

Hello Bruno,

Merci beaucoup pour ce gros pas en avant, je cerne mieux les sélections de colonne (colonne H).

Je vais faire tourner ça et vais batailler désormais pour que ma macro ne tourne que sur mes cellules visibles après filtrage....

Pourrais-je te demander conseil à l'occaz (et j'espère au cas ou) ?


Bonne journée à toi même s'il fait froid...


PS: en Asie du Sud c'est pas pareil......

 

[Spiekermayo]

Re : Copie d'onglets s'ils existent deja dans ma feuille

Bonjour Bruno,


J'ai ajoute une ligne de code afin que ma macro ne tourne que sur les cellules que j'ai filtre (module 1).

Je t'ai joins un fichier avec un filtre en colonne A (ID).

Si je ne veux que l'ID = 1 pas de probleme, ma macro me copie bien mes onglets voulus


Par contre si je veux ID = 2 elle me copie les onglets de ID=1 et de ID=2.
Et ainsi de suite si je veux ID=3 elle va copier ID=1, 2 et 3......


Je ne sais pas comment faire, j'ai passe la journee dessus a patoger

Si tu as un moment ou une idee.


Bonne journee.

 

[youky(BJ)]

Re : Copie d'onglets s'ils existent deja dans ma feuille

Salut
Je crois comme ca
Bruno

Sub add_sheets()
Dim NbF As Long, i As Long, Nf As String, c
With Sheets(1)
On Error Resume Next
For Each c In .Range("H2:H" & .[H65000].End(3).Row)
  If .Rows(c.Row).Hidden = False Then
      Sheets(c.Text).Copy After:=Sheets(Sheets.Count)
     If Err > 0 Then
      MsgBox "Impossible de copier..." & c.Text
      Err.Clear
     Else
      ActiveSheet.[G1] = .Cells(c.Row, 1)
      ActiveSheet.[I1] = .Cells(c.Row, 2)
      ActiveSheet.[G3] = .Cells(c.Row, 4)
     End If
   End If
 Next
End With
End Sub

 

[Spiekermayo]

Re : Copie d'onglets s'ils existent deja dans ma feuille

heyhey Bruno

Ca tourne comme une soirée un bien arrosée ..... merci beaucoup y tu m'as (encore) enlevé une belle épine du pied

C'est très gentil de ta part.

Bonne fin de semaine