Attribuer Noms différents à Plage copiée

Bonjour

Je cherche à faire ceci :

Feuille DONNEES , de A2 = A374 ==> Des dates (du 30/12/2011 au 05/01/2013)

1 - Copier dans la Feuille TABLO , à partir de A2, 8 fois cette liste. (ça, je sais faire)

Sub Duplique()
For i = 1 To 8
Sheets("Donnees").Range("A2:A374").Copy
Sheets("TABLO").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Next i
End Sub

Ce que je n'arrive pas à faire :

2 - A chaque copie doit correspondre un nom différent en colonne B.

Exemple : B2:B374 = Nom 1

B375:B747 = Nom 2

etc

J'ai essayé avec Array(Nom1, Nom2 ... mais sans succès

Merci de votre aide.

Amicalement

Nad

Bonjour

Pas tester:

Sub Duplique()
For i = 1 To 8
Sheets("Donnees").Range("A2:A374").Copy
Sheets("TABLO").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.Names.Add Name:="nom" & i, RefersToR1C1:="=tablo!R2C2:R374C2"
Next i

End Sub

Bonjour cb60 et merci de ta réponse.

Je me suis sans doute mal exprimée. Je ne veux pas de nom défini mais que dans la colonne B on ait :

B2:B374 =TARTEMPION

B375:B747 = UNTEL

etc...

8 noms différents

Amicalement

Nad

Bonjour

Un peu compliqué comme solution

Option Explicit

Sub Duplique()
Dim I As Integer
Dim Lg As Long
Dim NbLg As Long
Dim Nom As String
Dim K As Integer

  Application.ScreenUpdating = False
  Range("A2:B" & Rows.Count).ClearContents
  Randomize
  NbLg = Sheets("Donnees").Range("A" & Rows.Count).End(xlUp).Row - 1 ' le -1 pour l'entête
  With Sheets("TABLO")
    For I = 1 To 8
      Nom = ""
      For K = 1 To Int(4 * Rnd + 5)
        Nom = Nom + Chr(Int(26 * Rnd + 65))
      Next K
      Lg = .Range("A" & Rows.Count).End(xlUp).Row + 1
      Sheets("Donnees").Range("A2:A374").Copy
      .Range("A" & Lg).PasteSpecial Paste:=xlPasteValues
      .Range("B" & Lg & ":B" & Lg + NbLg - 1).Value = Nom
    Next I
  End With
End Sub

Re

Bonjour Banzaï

Merci de ton aide mais ce n'est pas ce que je recherche. Les noms sont connus.

J'ai 8 chauffeurs (PIERRE, PAUL, JACQUES, MARTIN, ARTHUR, PHILIPPE, SIMON, ANATOLE)

Lors de la 1ère copie dans A2:A374, je voudrais qu'en B2:B376 s'inscrive PIERRE

A la seconde copie (donc dans A375:A747), je voudrais qu'en B375:B747 s'inscrive JACQUES

Et ainsi de suite pour les 6 autres copies et donc les 6 autres chauffeurs.

Si trop compliqué, je me servirai de ton code et je ferai des RECHERCHER ==> REMPLACER

Amicalement

Nad

Bonjour

Alors c'est plus simple

Option Explicit

Sub Duplique()
Dim I As Integer
Dim Lg As Long
Dim NbLg As Long
Dim NomChauffeur() As String

  Application.ScreenUpdating = False
  NomChauffeur = Split("PIERRE,PAUL,JACQUES,MARTIN,ARTHUR,PHILIPPE,SIMON,ANATOLE", ",")

  Range("A2:B" & Rows.Count).ClearContents

  NbLg = Sheets("Donnees").Range("A" & Rows.Count).End(xlUp).Row - 1 ' le -1 pour l'entête
  With Sheets("TABLO")
    For I = 1 To 8
      Lg = .Range("A" & Rows.Count).End(xlUp).Row + 1
      Sheets("Donnees").Range("A2:A374").Copy
      .Range("A" & Lg).PasteSpecial Paste:=xlPasteValues
      .Range("B" & Lg & ":B" & Lg + NbLg - 1).Value = NomChauffeur(I - 1)
    Next I
  End With
End Sub

Re

Re Re Edit,la tu a une zone nommée pour chaque nom et la copie de ce nom en col B!!!!

Bon j'avais pas tout compris

Tu peux tester cela ( remettre le bon nombre de cellule.

Sub Duplique()

Dim ligne As Long

Sheets("TABLO").Cells.ClearContents

ExecuteExcel4Macro "SUM(DELETE.NAME(NAMES()))"

ActiveWorkbook.Names.Add Name:="nom1", RefersToR1C1:="=donnees!R2C1:R37C1"

For i = 1 To 8

nom = Array("aaa", "bbb", "ccc", "ddd", "eee", "fff", "ggg", "hhh")

ligne = Sheets("TABLO").Range("A" & Rows.Count).End(xlUp).Row

Sheets("Donnees").Range("nom1").Copy Destination:=Sheets("TABLO").Range("A" & ligne).Offset(1, 0)

ligne1 = Sheets("TABLO").Range("A" & Rows.Count).End(xlUp).Row

ActiveWorkbook.Names.Add Name:=nom(i - 1), RefersTo:=Sheets("TABLO").Range(Range("A" & ligne + 3), Range("A" & ligne1))

Sheets("TABLO").Range(Range("B" & ligne + 3), Range("B" & ligne1)) = nom(i - 1)

Next i

End Sub

Bonjour

Code à essayer :

Sub Duplique()
Dim i As Byte
Dim dlg As Long
Application.ScreenUpdating = False
For i = 1 To 8
Sheets("Donnees").Range("A2:A374").Copy
With Sheets("TABLO")
    .Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    dlg = .Range("A65536").End(xlUp).Row
    .Range("G" & i + 4).Copy .Range("B" & dlg & ":B" & Range("B" & Rows.Count).End(xlUp).Row + 1)
End With
Next i
End Sub

Amicalement

Re

Merci à tous

Problème réglé.

Amicalement

Nad