Copier coller des cellules non vides

**sommongkul** · 01/06/2018, 15h38

Bonjour,
Je suis un nouveau sur ce forum. Ma tache est de faire copier et coller des donnees dans la feuille 1 vers la feuille 2 en supprimant des cellules vides. J'ai déjà écrit une code qui me permet de faire copier et coller des cellules non vides mais je n'arrive pas à mettre mes données dans le bon ordre. Je voulais que tous les cellules contenu des numerique soient bien rangé comme je vous montre dans la feuille3. Est ce que quelcun parmi vous peut m'aider. Je suis un novice dans le macro.

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
29
30
 
Sub copy()
Dim i As Integer
Dim compteur As Integer
Dim DernCol As Integer
Dim DernLigne As Integer
Dim Cell As Variant
Dim FL1 As Worksheet, FL2 As Worksheet, Plage As Range
Set FL1= Sheets("Feuil1")
With FL1
            DernCol=.Range("A1").End(xlToRight).Column 'Derniere colonne
            DernLigne=.Range("A1").Cells(65536,DernCol).End(xlUp).Row ' Derniere ligne
            Set Plage =.Range("A1", .Cells(DernLigne,DernCol))
            For j=1 To Columns(Split(FL1.UsedRange.Address, "$")(3)).Column
                  Cell=""
                  compteur=0
                  For i=1 to Split(FL1.UsedRange.Address, "$")(4)
                        Cell=Plage.Cells(i,j).Value
                        If Cell<>"" Then
                            compteur=compteur+1
                             Set FL2=Sheets("Feuil2")
                              FL2.Cells(compteur,j).Value=Cell
                        Else:
                        End If
                  Next i
            Next j
End With
Set FL1=Nothing
Set Plage= Nothing
End Sub

discussion.xlsx

**BENNASR** · 02/06/2018, 11h10

Bonjour
voir avec :

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
Sub test()
' *****************nétoyer feuille 2
With Sheets("feuil2")
.Cells.Clear
End With
 
'*******************Nommer les titres des colonnes
    Sheets("feuil2").Cells(1, 1) = "Data"
    Sheets("feuil2").Cells(2, 1).Resize(1, 8) = Array("year", "month", "day", "hour", "", "", "sum", "condition")
 
'********************copier 
Dim Tablo
Dim i As Long
Tablo = Sheets("feuil1").Range("A3", "F" & Sheets("feuil1").Range("F" & Rows.Count).End(xlUp).Row)
k = 3
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If Tablo(i, 1) <> "" Then
    Sheets("feuil2").Range("A" & k) = Tablo(i, 1)
    Sheets("feuil2").Range("B" & k) = Tablo(i, 2)
    Sheets("feuil2").Range("C" & k) = Tablo(i, 3)
    Sheets("feuil2").Range("D" & k) = Tablo(i, 4)
    Sheets("feuil2").Range("G" & k) = Tablo(i, 5)
    Sheets("feuil2").Range("H" & k) = Tablo(i, 6)
    k = k + 1
    End If
Next i
Sheets("feuil2").Select
End Sub

**patricktoulon** · 02/06/2018, 13h04

Bonjour BENNASR
Pourquoi faire simple quand on peu faire compliqué

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Dim F1, F2, plage As Range
    Set F1 = Sheets("Feuil1"): Set F2 = Sheets("Feuil2")
    '   *********************nétoyer feuille 2 et mise des entetes de colonne
    With F2.Cells
        .Clear: .Cells(1, 1) = "Data"
        .Cells(2, 1).Resize(1, 6) = Array("year", "month", "day", "hour", "sum", "condition")
    End With
    '********************filtre et copie sur sheets (2)copier
    Set plage = F1.Range("A3:F" & F1.Range("F" & Rows.Count).End(xlUp).Row)
    With plage: .AutoFilter Field:=1, Criteria1:="<>": .Copy Destination:=F2.Cells(3, 1): End With
    '***********separation des deux dernieres colonnes
    With F2: .Columns("E:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove: .Select: End With
End Sub

le copie destination est beaucoup plus rapide qu'une boucle de filtrage dans variable tableau et transposition du tableau obtenu sur plage
pour la separation des deux dernieres colonnes une simple insertion

**BENNASR** · 02/06/2018, 14h08

Bonjour patrick, la forum
Je n'ai qu'à comprendre, apprendre et copier ton code dans mon bibliothèque des codes VBA

Bonne journée

**sommongkul** · 04/06/2018, 09h58

Bonjour vous deux
Merci pour vos réponses assez rapide. Comme je viens d'entrer dans mon compte sur ce forum, je n'ai pas encore essayé de tester vos codes. Je vais faire un teste sur vos codes et vous dire si ca fonctionne bien.

**sommongkul** · 04/06/2018, 10h16

Je viens de tester le code de BENNASR. Votre code marche bien comme ce que je veux faire.
****************************************************************************
Par contre, le code de Patricktoulon me permet presque d'obtenir un bon résultat. Votre code copie toutes les cellules meme si quelques cellules sont vides. Pouvez-vous m'aider encore une fois de faire ce que vous avez déjà fait et ajouté une partie de supprimer toutes les cellules vides.

Je remercie à vous deux enormement.
Cordialement,
Mongkul

**patricktoulon** · 04/06/2018, 10h41

Bonjour
j'ai testé mon code avant de te le donner il fait exactement ce que tu demande avec tes captures
si il y a modification dans ton projet il faut etre plus precis

**sommongkul** · 04/06/2018, 10h51

Bonjour Patrick
Je ne savais pas. Quand je lance le calcul dans mon PC, il apparait une ligne vide(ligne 3) dans ma feuille .

**patricktoulon** · 04/06/2018, 11h01

serait elle vide de "B" A la fin et pleine en "A" par hasard??
je te repondrais ce soir je part la j'ai de la route a faire
a+

**sommongkul** · 04/06/2018, 11h42

Merci beaucoup, Patrick.

**patricktoulon** · 04/06/2018, 15h52

bon je suis de reour
alors que veux tu exactement?
donne un exemple de base et le resultat

**sommongkul** · 04/06/2018, 16h00

Envoyé par patricktoulon

bon je suis de reour
alors que veux tu exactement?
donne un exemple de base et le resultat

Rebonjour
Je vous joins un ficher excel que je voulais faire. Je voudrais faire le copier et coller de feuille 1 à feuille 3 en supprimant des cellules vides et en mettant des données numériques dans un bon ordre comme je vous ai déjà montré dans la feuille 3. J'ais besoin d'un code macro qui me permet de faire ça.

discussion.xlsx

**patricktoulon** · 05/06/2018, 09h42

re
pour la mise en ordre je pige pas trop les données semblent l'etre pour le reste je te l'ai donné 2 fois deja

une derniere fois

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
   With Sheets(1).Range("A1",Cells(Rows.count,1).end(xlup))
        .AutoFilter Field:=1, Criteria1:="<>"
        .Copy Destination:=Sheets("Feuil3").Range("A1")
        .AutoFilter
        With Sheets("Feuil3")
           .Activate        'pour voir le resultat
         .Columns("E:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("A1:D1").MergeCells = False
        End With
    End With
    Application.CutCopyMode = False
End Sub

Nom : demo5.gif
Affichages : 3691
Taille : 175,1 Ko

**sommongkul** · 05/06/2018, 10h16

Envoyé par patricktoulon

re
pour la mise en ordre je pige pas trop les données semblent l'etre pour le reste je te l'ai donné 2 fois deja

une derniere fois

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
   With Sheets(1).Range("A1",Cells(Rows.count,1).end(xlup))
        .AutoFilter Field:=1, Criteria1:="<>"
        .Copy Destination:=Sheets("Feuil3").Range("A1")
        .AutoFilter
        With Sheets("Feuil3")
           .Activate        'pour voir le resultat
         .Columns("E:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("A1:D1").MergeCells = False
        End With
    End With
    Application.CutCopyMode = False
End Sub

Merci beaucoup , Patrick de prendre votre temps. Ce code me donne exactement ce que je voulais.

Copier coller des cellules non vides [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager