Recuperer des donnees

manulemalin13000

XLDnaute Occasionnel
Bonjour le forum,

J'ai un fichier excel avec beaucoup de donnees uniquement en colonne A
Ces donnees sont reparties ainsi:

environ 130 lignes de données (que j'appelle bloc 1)
1 saut de ligne
puis 120 lignes de donnees (bloc 2)
1 saut de ligne
puis 150 lignes de donnees (bloc 3)

TOUT CELA UNIQUEMENT EN COLONNE A !!

Ce que je veux faire :
Une macro qui irait prendre le bloc 1 pour le coller colonne A
Bloc 2 > Colonne B
Bloc 3 > Colonne C
et ainsi de suite

Merci pour votre aide
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Recuperer des donnees

Bonjour Manulemalin, bonjour le forum,

Peut-être comme ça :
Code:
Sub Macro1()
'déclare les variables pl (Première Ligne) et dl (Dernière Ligne) pour chaque bloc (B)
Dim dlb3 As Range, plb3 As Range, dlb2 As Range, plb2 As Range, dlb1 As Range, plb1 As Range
Set dlb3 = Range("A65536").End(xlUp) 'définit la dernière ligne du bloc 3
Set plb3 = dlb3.End(xlUp) 'définit la première ligne du bloc 3
Set dlb2 = plb3.End(xlUp) 'définit la dernière ligne du bloc 2
Set plb2 = dlb2.End(xlUp) 'définit la première ligne du bloc 2
Set dlb1 = dlb2.End(xlUp) 'définit la dernière ligne du bloc 1
Set plb1 = dlb1.End(xlUp) 'définit la première ligne du bloc 1
Application.ScreenUpdating = False 'masque les changement à l'écran
Range(plb2, dlb2).Cut Range("B1") 'coupe et colle le bloc 2 dans la colonne B
Range(plb3, dlb3).Cut Range("C1") 'coupe et colle le bloc 3 dans la colonne C
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub
 
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : Recuperer des donnees

Bonjour manulemalin13000, Bonjour Robert :),
Une proposition sans connaitre le nombre de blocs à déplacer:
Code:
[COLOR=blue]Sub[/COLOR] Copie_blocs()
[COLOR=blue]Dim[/COLOR] LstRow#, Col#, i#, Plg
Application.ScreenUpdating = 0
[COLOR=blue]With[/COLOR] Sheets("Feuil1")
    Col = 2: i = 1
    LstRow = .Cells(i, 1).End(xlDown).Row
    [COLOR=blue]Do While[/COLOR] LstRow <> Rows.Count
        Plg = Range(.Cells(i, 1), .Cells(LstRow, 1))
        Cells(1, Col).Resize([COLOR=blue]UBound[/COLOR](Plg, 1), 1) = Plg
        Col = Col + 1
        i = LstRow + 2
        LstRow = .Cells(i, 1).End(xlDown).Row
    [COLOR=blue]Loop[/COLOR]
    Columns(1).Delete
[COLOR=blue]End With[/COLOR]
Application.ScreenUpdating = 1
[COLOR=blue]End Sub[/COLOR]
Cordialement
 

Discussions similaires

Statistiques des forums

Discussions
312 500
Messages
2 089 013
Membres
104 004
dernier inscrit
mista