Discussion :

[Thewil]

Bonjour,

J'ai des données dans une feuille excel sous ce format.

1 2
3 4
5 6
7 8

Je voudrais récupérer ces données pour les mettre dans une autre feuille d'un autre fichier excel sous cette forme la :
1 2 3 4 5 6 7 8

J'ai fait qqchose comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
    Range("B12,D12,B20,D20,B27,D27,B33,D33").Select
    Selection.Copy
 
 
    Range("E" & ouCopier & ":L" & ouCopier).Select
    Range("E" & ouCopier).Activate
    Sheets("DATA").Range("E" & ouCopier).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _False, Transpose:=True

Mais j'obtiens qqchose comme ceci :
1 3 5 7
2 4 6 8

Ce qui ne conviens pas comme vous pouvez le voir.

Auriez vous une petite idée svp ?

Merci

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim i As Long
 
For i = 2 To Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
    Range("A" & i & ":B" & i).Copy Cells(1, Cells(1, Rows(1).Cells.Count).End(xlToLeft).Column + 1)
    Range("A" & i & ":B" & i).ClearContents
Next

[Thewil]

Euh je comprend pas trop la en lisant le code en fait. Comment cela va t'il coller mes données dans le fichier excel cible qui doit contenir les données dans les cellules de E à L ??

[Maiden002]

Bonjour Thewill, mercatog, le forum,

Le code que mercatof ta donné te permet de prendre les informations de la colonne A et B, et de les assemblé dans l'ordre sur la premiére ligne.

En clair en ligne 1 tu aura dans chaque cellule le nombre a la suite.

Si tu as 8 num, tu aura 8 num a la ligne 1 étendu sur 8 cellule, donc jusqu'a la colonne H

Que recherche tu précisément ?? Car son code marche nikel

[Thewil]

Ah j'ai du mal m'exprimé. Car du coup ce que vous me proposez ne peux pas fonctionner.

Dans ma feuille source j'ai qqchose du genre :

1 R 2
R R R
R R R
3 R 4

5 R 6
R R R
R R R
7 R 8

Tout les R sont des cellules dont je n'ai pas besoin. Le but étant donc d'obtenir tous mes numéros dans une feuille cible dans cette disposition

Mes données 1 2 3 4 5 6 7 8
Mes colonnes E F G H I J K L

[mercatog]

Il fallait spécifier clairement la question
ici une proposition
1. Données dans ClasseurA.xls (feuille: FeuilA, plage: A1:C*) '*Dernière ligne de données
2. à copier dans ClasseurB.xls (feuille: FeuilB, à partir de E1) avec ClasseurB.xls dans le même dossier que ClasseurA.xls
3. Code à mettre dans ClasseurA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Dim LastLig As Long, i As Long
Dim j As Integer
Dim wbk As Workbook, awbk As Workbook
Dim sht As Worksheet
 
Application.ScreenUpdating = False
Set awbk = ThisWorkbook
Set wbk = Workbooks.Open(ThisWorkbook.Path & "\ClasseurB.xls")
Set sht = wbk.Sheets("FeuilB")
 
With awbk.Sheets("FeuilA")
    LastLig = .Cells(.Columns(1).Cells.Count, 1).End(xlUp).Row
    j = 5
    For i = 1 To LastLig
        If IsNumeric(.Range("A" & i).Value) And .Range("A" & i).Value <> "" Then
            .Range("A" & i & ",C" & i).Copy sht.Cells(1, j)
            j = j + 2
        End If
    Next i
End With
wbk.Save
wbk.Close
 
Set awbk = Nothing
Set wbk = Nothing
Set sht = Nothing
 
Application.ScreenUpdating = True

[Fvandermeulen]

Salut,
Regarde ceci, par contre j'ai pas gérer le cas de l'autre classeur, pour le coup il place sur une autre feuille du classeur, tu n'as qu'à adapter à ton cas.
Tout comme tu dois adapter la plage et éventuellement le contrôle sur base des données réelles.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub transpose()
 
Dim MaPlage As Range, cel As Range
Dim ColCible As Long
 
Set MaPlage = Sheets("sheet1").Range("A1:C9") 'Défini la plage à traiter
ColCible = 1 'défini la première valeur de la colonne où placer les données
 
For Each cel In MaPlage 'Passe sur chaque cellule de la plage
    If IsNumeric(cel) And Not IsEmpty(cel) Then 'Si numéric(<>R) et non vide
        Sheets("Data").Cells(1, ColCible) = cel 'On place la valeur de la cellule vérifiée dans l'autre feuille
        ColCible = ColCible + 1 'Incrémente la colonne où on place la valeur trouvée
    End If
Next cel 'Passe à la cellule suivante (de gauche à droite)
 
End Sub

A+

Edit: Désolé pour le doublon, d'autant qu'il est moins précis puisque pas de gestion du 2ème classeur...

[Thewil]

Bon voila j'ai fais des screenshots en espérant que ça vous permette de mieux comprendre car en effet j'ai du mal expliqué mon soucis :

http://www.monsterup.com/image.php?u...5535815170.png

Donc ça c'est le fichier A, sheet 1. Je veux donc récupérer les données qui sont dans les carrés rouges.

http://www.monsterup.com/image.php?u...5535816130.png

Ca c'est le fichier B, sheet DATA dans lequel je veux recopier mes données issues du fichier A.
Ma macro se situe donc dans ce fichier la.

Désolé je ne sais pas comment mieux expliquer

Je continu à essayer de mon côté.

Merci à vous

[mercatog]

Tu as besoin encore de clarifier...
Que "tes cases encadrées en rouge" ont de spécial?
il faut préciser le critère du choix de la cellule à copier

[Thewil]

Bon voila j'ai réussi en adaptant un petit peu.

Merci à tous, ça faisait longtemps que j'avais pas fait du VB et ben quand je vois le "merdier" je suis pas mécontent

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
    Dim MaPlage As Range, cel As Range
    Dim ColCible As Long
 
    Set MaPlage = Sheets(lafeuille).Range("C12:D12,C20:D20,C27:D27,C33:D33") 'Défini la plage à traiter
    ColCible = 5 'défini la première valeur de la colonne où placer les données 5 = colonne E
 
    For Each cel In MaPlage 'Passe sur chaque cellule de la plage
        If Not IsEmpty(cel) Then 'Si non vide
            Windows(nomDestination).Activate
            Sheets("DATA").Activate
            Sheets("DATA").Select
            Sheets("Data").Cells(ouCopier, ColCible) = cel 'On place la valeur de la cellule vérifiée dans l'autre feuille
            ColCible = ColCible + 1 'Incrémente la colonne où on place la valeur trouvée
        End If
    Next cel 'Passe à la cellule suivante (de gauche à droite)