Copiercoller valeur ds autre feuille avec itération colonne

Bonjour,

Je suis débutant avec vba (je teste depuis hier soir). Voilà ce que je veux faire :

• Dans excel, j'ai une feuille par élève regroupant des calculs.
• Sur la feuille de chaque élève je veux copier les valeurs (et non les formules) de 3 colonnes.
• Les infos copiées, je veux les coller sur 1 seule feuille permettant de tout centraliser.
• La difficulté est que je veux coller le premier élève sur les 3 premières colonnes, puis le second sur les colonne 5 6 et 7 (une colonne d'espace entre chaque élève) et ainsi de suite.

Voici le code que j'ai écrit mais qui ne fonctionne pas car aucune information n'est collée et j'ai une erreur 9 sur la ligne Columns(x).PasteSpecial xlPasteAll:

Sub CopierColler()

Dim i, x, y, z As Integer

i = 3

x = 1

y = 2

z = 3

Worksheets(i).Select

Columns(34).Formula = Columns(34).Value

Columns(35).Formula = Columns(35).Value

Columns(36).Formula = Columns(36).Value

Worksheets(i).Select

Columns(34).Copy

With Sheets("parents T1")

Columns(x).PasteSpecial xlPasteAll

End With

Worksheets(i).Select

Columns(35).Copy

With Sheets("parents T1")

Columns(y).PasteSpecial xlPasteAll

End With

Worksheets(i).Select

Columns(36).Copy

With Sheets("parents T1")

Columns(z).PasteSpecial xlPasteAll

End With

i = i + 1

x = x + 3

y = y + 3

z = z + 3

If i = 33 Then Exit Sub

End Sub

Pouvez me donner un coup de main ?

Merci d'avance

J'ai simplifié le code,

Sub boucle_while()

Dim i, x, y, z As Integer

i = 4

x = 1

y = 2

z = 3

While i <= 6

Worksheets(i).Select

Columns(34).Copy

Sheets("pT1").Select

Columns(x).PasteSpecial xlPasteValues

Worksheets(i).Select

Columns(35).Copy

Sheets("pT1").Select

Columns(y).PasteSpecial xlPasteValues

Worksheets(i).Select

Columns(36).Copy

Sheets("pT1").Select

Columns(z).PasteSpecial xlPasteValues

i = i + 1

x = x + 4

y = y + 4

z = z + 4

Wend

End Sub

Par contre, est-il possible de copier la valeur et le format d'une cellule sans faire columns(x).formula=columns(x).values parce que c'est très long pour l’exécution du code pour 30 feuilles élèves ?

Merci d'avance

Bonjour

Un exemple à tester

Option Explicit     ' Oblige la déclaration des variables

Sub CopierColler()
' Coller les valeurs des colonnes 34,35,36 des feuilles 3 à 33
' On espace d'une colonne chaque élève
Dim I As Integer, Colonne As Integer

  Application.ScreenUpdating = False    ' Pas de rafraichissement écran (code tourne plus vite)
  Colonne = 1               ' Colonne de départ
  For I = 3 To 33           ' de la 3ème à la 33ème feuille
    Sheets(I).Columns("AH:AJ").Copy     ' On copie ces 3 colonnes
    ' collage spécial ---> Valeurs
    Sheets("parents T1").Columns(Colonne).PasteSpecial Paste:=xlPasteValues
    ' On déplace la colonne de réception de 4
    Colonne = Colonne + 4
  Next I
  Application.CutCopyMode = False     ' Purge le tampon copier
End Sub

PS: Utilises les balise Code pour ton code

Merci beaucoup pour ta réponse !

Ton code est effectivement au moins 10 fois plus rapide que le miens.

Existe-t-il une méthode pour copier également le format des cellules ? Sans passer par formula=value ?

Sub CopierColler()

Dim I, var1, var2 As Integer

Application.ScreenUpdating = False ' Pas de rafraichissement écran

var1 = 1

var2 = var1 + 2

For I = 4 To 33 ' dépend du nombre d'élèves

Sheets(I).Columns("AH:AJ").Copy

Sheets("pT1").Columns("var1:var2").PasteSpecial Paste:=xlFormats

Sheets(I).Columns("AH:AJ").Copy

Sheets("pT1").Columns("var1:var2").PasteSpecial Paste:=xlPasteValues

Cells(1, var1 + 2).Value = Sheets(I).Name

var1 = var1 + 4

Next I

Application.CutCopyMode = False ' Purge le tampon copier

End Sub

K'ai trouvé une solution mais il y un nouveau problème avec columns("var1:var2"), il y a une erreur.

Savez-vous pourquoi ?

Bonjour

Utilises les balises code lorsque tu insères du code : C'est plus lisible

Option Explicit     ' Oblige la déclaration des variables

Sub CopierColler()
' Coller les valeurs des colonnes 34,35,36 des feuilles 3 à 33
' On espace d'une colonne chaque élève
Dim I As Integer, Colonne As Integer

  Application.ScreenUpdating = False    ' Pas de rafraichissement écran (code tourne plus vite)
 Colonne = 1               ' Colonne de départ
 For I = 3 To 33           ' de la 3ème à la 33ème feuille
   Sheets(I).Columns("AH:AJ").Copy     ' On copie ces 3 colonnes
   ' collage spécial ---> Valeurs
   Sheets("parents T1").Columns(Colonne).PasteSpecial Paste:=xlPasteFormats
   Sheets("parents T1").Columns(Colonne).PasteSpecial Paste:=xlPasteValues
    ' On déplace la colonne de réception de 4
   Colonne = Colonne + 4
  Next I
  Application.CutCopyMode = False     ' Purge le tampon copier
End Sub

Sub InsereFeuille()
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "pT1"
    End Sub

Sub CopierColler()

Dim I, x As Integer

  Application.ScreenUpdating = False    ' Pas de rafraichissement écran
 x = 1
 For I = 4 To 32           ' de la 3ème à la 33ème feuille

Sheets(I).Columns("AH:AJ").Copy
Sheets("pT1").Columns(x).PasteSpecial Paste:=xlPasteValues
  Sheets(I).Columns("AH").Copy
  Sheets("pT1").Columns(x).PasteSpecial Paste:=xlPasteFormats

  Sheets(I).Columns("AI").Copy
  Sheets("pT1").Columns(x + 1).PasteSpecial Paste:=xlPasteFormats

  Sheets(I).Columns("AJ").Copy
  Sheets("pT1").Columns(x + 2).PasteSpecial Paste:=xlPasteFormats
Cells(1, x + 2).Value = Sheets(I).Name
   x = x + 4
  Next I
  Application.CutCopyMode = False     ' Purge le tampon copier
End Sub

ça marche impec avec ce code.

Merci encore pour votre aide ! le programme s'exécute en très peu de temps grâce à vous.

Une merveille !

Bonjour

Je ne comprenais pas pourquoi tu répéter 3 fois la commande et en faisant des essais j'ai compris

Essayes ce code

Sub CopierColler()
' Il faut typer chaque variable : Sinon c'est Variant par défaut
Dim I As Integer, x As Integer

  Application.ScreenUpdating = False    ' Pas de rafraichissement écran
  x = 1
  With Sheets("pT1")
    For I = 4 To 32           ' de la 4ème à la 32ème feuille

      Sheets(I).Columns("AH:AJ").Copy
      .Columns(x).Resize(, 3).PasteSpecial Paste:=xlPasteFormats
      .Columns(x).PasteSpecial Paste:=xlPasteValues
      .Cells(1, x + 2).Value = Sheets(I).Name
      x = x + 4
    Next I
  End With
  Application.CutCopyMode = False     ' Purge le tampon copier
End Sub

Même les commentaires sont importants ( tu le comprendras quand tu reprendras ton code dans quelques temps)

Sub InsereFeuille()
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "pT1"
    End Sub

Sub CopierColler()
' Il faut typer chaque variable : Sinon c'est Variant par défaut
Dim I As Integer, x As Integer

  Application.ScreenUpdating = False    ' Pas de rafraichissement écran
 x = 1
  With Sheets("pT1")
    For I = 4 To 33           ' de la 4ème à la 32ème feuille

      Sheets(I).Columns("AH:AJ").Copy
      .Columns(x).PasteSpecial Paste:=xlPasteValues
      .Columns(x).Resize(, 3).PasteSpecial Paste:=xlPasteFormats

      .Cells(1, x + 2).Value = Sheets(I).Name
      x = x + 4
    Next I
  End With
  Application.CutCopyMode = False     ' Purge le tampon copier
End Sub

Voilà le code final. Pour que cela marche il faut d'abord que je colle les valeurs avant le format. Sinon je pense qu'il ne sait pas où coller ses valeurs à cause des fusions de cellules.

Le resize(,3) sert à quoi ? coller 3 colonnes ?

Il ne me reste plus qu'à inclure les boutons pour lancer les macros.

J'ai trouvé ce protocole : Vas dans AFFICHAGE / BARRE D'OUTILS / FORMULAIRE, choisis ton bouton et dessine le sur ta feuille.

Ensuite clique droite sur le botuon et, dans le menu, choisis AFFECTER A UNE MACRO. Cependant, je n'ai pas le "formulaire".

Avez-vous un autre moyen pour faire le bouton ?

Merci encore pour votre aide !

En fait, j'ai réussi !

Merci encore pour le temps passé à m'aider.

A bientôt