coller sur la dernière cellule d'une ligne, pas d'une colonne

[erge57]

Bonjour le forum,

J'ai créé un classeur pour l'organisation d'une compétition et il y a un petit problème que je ne sais résoudre.

Je pensais quand utilisant cette formule cela fonctionnerais, mais non ça ne va pas.
x = Sheets("Inscr").Range("B10:B" & Rows.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Sheets("Inscr").Range("B10:B" & x).Copy
Sheets("Jeux").Range("H" & Column.Count).End(xlToLeft).Column.Offset(2, 0).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=True

Pourriez-vous m'aider ?

Pour plus d'explication, je joints un exemple du fichier

Merci pour votre aide,

Georges

 

[Paf]

Bonjour,

Pas facile sans la feuille destination dans le classeur.

un essai qui copie de feuil1 en feuil2 en une seule ligne sur la première ligne libre à partir de la colonne A

Sub CopieJoueurs()
Dim DL As Long, DC As Long, i As Byte
DL = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row + 1
DC = 0
Application.ScreenUpdating = False

With Worksheets("Feuil1")
For i = 2 To 5
    DerL = .Cells(.Cells.Rows.Count, i).End(xlUp).Row
    DC = DC + 1
    .Range(Cells(7, i), Cells(DerL, i)).Copy
    Worksheets("Feuil2").Cells(DL, DC).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    DC = Worksheets("Feuil2").Cells(DL, Columns.Count).End(xlToLeft).Column
    Application.CutCopyMode = False
Next
End With
Application.ScreenUpdating = True
End Sub

 

[erge57]

Merci beaucoup Paf,

En vertical, la formule fonctionne très bien, mon problème c'est l'horizontalité et vous y avez très bien répondu.
Ce n'est pas exactement comme je le voyais, c'est mieux.
Moi je pensais utiliser la formule 4 fois, mais une seul formule c'est mieux.

C'est parfait merci,

Georges

 

[Paf]

Moi je pensais utiliser la formule 4 fois, mais une seul formule c'est mieux.

en fait j'utilise bien l'instruction 4 fois. ("la formule" est plutôt réservé aux fonctions écrites dans les cellules)
elle n'est écrite qu'une fois mais dans une boucle de 2 à 5 (pour les colonnes : 2=B, 3= C...)
donc l'instruction est exécutée 4 fois.

 

[job75]

Bonsoir erge57, Paf,

Autre solution avec le résultat en Feuil2 :

Sub ListeJoueurs()
Dim tablo, resu(), e, n%
With Feuil1.[B6].CurrentRegion.Offset(1)
    tablo = .Value
    ReDim resu(1 To Application.CountA(.Cells))
End With
For Each e In tablo
    If e <> "" Then n = n + 1: resu(n) = e
Next
'---restitution---
With Feuil2.Rows(2)
    .ClearContents
    .Resize(, n) = resu
End With
End Sub

A+

 

[erge57]

Bonsoir Job75,

Il y a un soucis avec votre code, il me donne "Erreur d'exécution '9':
L'indice n'appartient pas à la sélection."
Et surligne "ReDim resu(1 To Application.CountA(.Cells))"
Mais ce n'est pas grave, j'ai la solution de Paf qui fonctionne super bien.

Un grand merci quand même pour votre réponce.

 

[erge57]

en fait j'utilise bien l'instruction 4 fois. ("la formule" est plutôt réservé aux fonctions écrites dans les cellules)
elle n'est écrite qu'une fois mais dans une boucle de 2 à 5 (pour les colonnes : 2=B, 3= C...)
donc l'instruction est exécutée 4 fois.

D'accord avec vous, mais quand même plus court que ma méthode.

Encore un très grand merci à vous, on peux considéré ce post comme résolu.

 

[erge57]

Mille excuse job75, Votre code fonctionne très aussi, c'est moi qui ais fait une grosse erreur, j'ai écrit les participant sur la feuille 2 au lieu de la feuille 1. En remettant tout dans l'ordre ça fonctionne mieux.

Un très grand merci a vous pour votre aide.