copie plage aleatoire

[jamespatagueul]

Bonjour le forum,

je cherche à copier une plage de lignes, d'un mot X a un mot Y, toujours dans la colonne A.
Et coller tous les résultats (plusieurs fois le même critère), en ligne par transpose.

Est ce jouable ?

exemple :feuil 1 A
X
A
B
C
D
E
Y
X
F
G
H
I
J
Y

coller en feuil2 A
xabcdey
xfghijy

Merci

 

[fourezizou]

Re : copie plage aleatoire

bonjour

peut être avec CONCATENER

feuil 2 dans la cellule A1=(A1&A2&A3&A4&...........&A (n ) ) de feuil 1

 

[jamespatagueul]

Re : copie plage aleatoire

Bonjour
merci de votre réponse
le nombre de ligne entre x et Y est variable.
du simple au double.

Merci

 

[Staple1600]

Re : copie plage aleatoire

Bonsoir à tous

jamespataguel
Ne t'ai je pas déjà répondu ici ?
https://www.excel-downloads.com/thr...ent-x-copier-cellule-plus-5-suivantes.231728/

Et pourquoi avoir ouvert deux fils ?
Le premier que tu as ouvert (suite à mon conseil) suffisait amplement, non ?

EDITION:
[noparse]Donc[/noparse] en simplement adaptant le premier code fourni dans le fil de boulebidule
A tester sur un classeur vierge.

Sub gDATA_test()
'macro ne servant qu'à créer des données de test
' à lancer en étant sur la feuille 1
With Range("A1:A6")
.Value = Application.Transpose(Array("X", "=ROW()", "=ROW()", "=ROW()", "=ROW()", "=ROW()"))
.AutoFill Destination:=Range("A1:A48"), Type:=xlFillCopy
End With
End Sub

Sub c()
'il faut qu'il existe une feuille 2 avant de lancer la macro
' à lancer en étant sur la feuille 1
Dim c As Range, i&, sValeur
i = 1
Application.ScreenUpdating = False
sValeur = InputBox("Valeur cherchée ?", "Recherche", "x")
For Each c In Columns(1).SpecialCells(xlCellTypeConstants, 2)
If c Like sValeur & "*" Then
c.Resize(6).Copy
Sheets(2).Cells(i, 1).Resize(, 6).PasteSpecial Paste:=xlPasteValues, Transpose:=True
i = i + 1
End If
Next c
Application.ScreenUpdating = True
End Sub

 

[ROGER2327]

Re : copie plage aleatoire

Bonsoir à tous.


Un autre code :

Sub toto()
Dim k&, l&, c&, x(), y$()
Const d$ = "x"
Const f$ = "y"
  With Feuil1.[A1]: x = Range(.Cells, .Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Offset(1)).Value: End With
  With Feuil2.[A1]
    With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
    .CurrentRegion.ClearContents
    x(UBound(x), 1) = f
    For k = 1 To UBound(x) - 1
      If LCase(x(k, 1)) = d Then
        ReDim y(0, 0)
        y(0, 0) = x(k, 1)
        c = 1
        Do Until LCase(x(k + 1, 1)) = f Or LCase(x(k + 1, 1)) = d
          k = k + 1
          If Not IsEmpty(x(k, 1)) Then
            ReDim Preserve y(0, c)
            y(0, c) = x(k, 1)
            c = c + 1
          End If
        Loop
        ReDim Preserve y(0, c + 1)
        y(0, c) = x(k + 1, 1)
        .Offset(l).Resize(1, c + 1).Value = y
        l = l + 1
      End If
    Next
    With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
  End With
End Sub

Bonne nuit.


ℝOGER2327
#7869

Mardi 24 Palotin 142 (Sainte Lumelle, écuyère - fête Suprême Quarte)
24 Floréal An CCXXIII, 9,0286h - valériane
2015-W20-3T21:40:07Z

 

[jamespatagueul]

Re : copie plage aleatoire

Bonjour tous,
et merci