Discussion :

[Freudsw]

Bonjour à tous,

J'ai besoin de votre aide pour copier des données. Dans un premier temps, je voudrais savoir comment copier une colonne entiere jusqu'a la derniere ligne remplie sans prendre l'entête.

Dans un second temps, jaimerais copier d'autres données sur la même feuille mais à partir de la derniere ligne vide (disponible).

J'ai commencé à coder un peu mais je rencontre des problèmes.

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
Sub Macro3()
Dim dligne As Long
Dim dernligne2 As Long
dligne = Worksheets("CK traité").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
 
            Worksheets("CK traité").UsedRange.Columns(12).EntireColumn.Copy Worksheets("CK final").Cells(1, 1)
            Worksheets("CK traité").UsedRange.Columns(7).EntireColumn.Copy Worksheets("CK final").Cells(1, 2)
            Worksheets("CK traité").UsedRange.Columns(13).EntireColumn.Copy Worksheets("CK final").Cells(1, 3)
            Worksheets("CK traité").UsedRange.Columns(15).EntireColumn.Copy Worksheets("CK final").Cells(1, 4)
            Worksheets("CK traité").UsedRange.Columns(6).EntireColumn.Copy Worksheets("CK final").Cells(1, 5)
 
 
 
 
 
           Worksheets("CK traité").UsedRange.Columns(12).EntireColumn.Copy Worksheets("CK final").Cells(dligne + 1, 1)
           Worksheets("CK traité").UsedRange.Columns(10).EntireColumn.Copy Worksheets("CK final").Cells(dligne + 1, 2)
           Worksheets("CK traité").UsedRange.Columns(14).EntireColumn.Copy Worksheets("CK final").Cells(dligne + 1, 3)
           Worksheets("CK traité").UsedRange.Columns(16).EntireColumn.Copy Worksheets("CK final").Cells(dligne + 1, 4)
           Worksheets("CK traité").UsedRange.Columns(9).EntireColumn.Copy Worksheets("CK final").Cells(dligne + 1, 5)
 
 
    Worksheets("CK traité").ShowAllData
     dernligne2 = Worksheets("CK final").Cells(Worksheets("CK final").Cells.Rows.Count, "A").End(xlUp).Row
    Worksheets("CK final").Range("F1") = "Chaine"
    Worksheets("CK final").Range("F2:F" & dernligne2).FormulaR1C1 = "CK"
 
End Sub

le message d'erreur affiché est (impossible de coller les cellules car elles sont de forme et de taille différentes)

Merci pour vos réponses.

Cordialement,

Freudsw

[Kiouane]

Pour retrouver la dernière cellule remplie de la colonne A par exemple :

Code :

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

Range("A"&Rows.count).end(xlup).row

Pour retrouver la première cellule vide de la colonne A par exemple il suffit de rajouter +1 à la formule précédente :

Code :

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

Range("A"&Rows.count).end(xlup).row +1

Pour sélectionner la colonne A sans l'entête jusqu'à la dernière ligne remplie :

Code :

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

1
2
n=Range("A"&Rows.count).end(xlup).row
Range("A2:A"&n).Select

Après je te conseille de te documenter pour pouvoir comprendre les différentes syntaxes. Il y a plusieurs articles intéressants dans le FAQ.

[vinc_bilb]

Bonjour,

Je vous suggère fortement de transcrire vos donnée d'entrée en table .... qui sont très faciles à manipuler puisque vous bénéficiez:

- de l'autofiltre
- des distinctions entre les entêtes et les données
- des listcolumns

Sans oublier le Range.CurrentRegion qui est au VBA ce que le Ctrl + * est à Excel ....

Exemple:

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
31
32
33
34
35
36
37
38
39
40
41
42
43
Function FilterTabl(Wsh As Worksheet, TablObjN As String, FiltFiledI As Integer, FiltCriterV As Variant, Optional RetBodyRngB As Boolean = True) As Range
' Filter a table and return the range after filtering
 
Sprocname = "FilterTabl"
 
    Dim WshProtB As Boolean
    Dim TablO As Object
 
' Init
    On Error GoTo Err_FilterTabl
    Set TablO = Wsh.ListObjects(TablObjN)
 
' Remove the previous filter if any
    Call ClearFilterTabl(Wsh, TablObjN)
    TablO.Range.AutoFilter
' Filter
    TablO.Range.AutoFilter field:=FiltFiledI, Criteria1:=FiltCriterV
 
    If RetBodyRngB = False Then
 
        Set FilterTabl = TablO.Range.SpecialCells(xlCellTypeVisible)
        Else: Set FilterTabl = TablO.DataBodyRange.SpecialCells(xlCellTypeVisible)
 
    End If
 
    Debug.Print FilterTabl.AddressLocal, FilterTabl.Rows.Count
 
    If FilterTabl.Cells.Count <= FilterTabl.Columns.Count Then
        MsgBox TablObjN & vbCrLf & "Warning: returned range has " & FilterTabl.Rows.Count & " row", vbExclamation, Sprocname
    End If
 
Err_FilterTabl:
 
    If Err.Number <> 0 Then
 
        Swarnmsg = "Error: " & Err.Number & vbCrLf & Err.Description
        MsgBox Swarnmsg, vbExclamation, Sprocname
        Err.Clear
        Exit Function
 
    End If
 
End Function

Exemple de manuplation range

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
' Data range
    Set Rngdata = WshSrc.Cells.SpecialCells(xlCellTypeLastCell).CurrentRegion
    Debug.Print Rngdata.AddressLocal; Rngdata.Areas.Count, Rngdata(1, 1).Column, Rngdata(1, 1).Row
 
        Irowscnt = Rngdata.Rows.Count
 
        For IcolN = Rngdata.Columns.Count To 1 Step -1
        ' Exemple pour supprimer les colonnes vides (ou juste avec un entête    
            If Application.WorksheetFunction.CountA(Rngdata.Columns(IcolN)) <= 1 Then
                Rngdata.Columns(IcolN).EntireColumn.Delete
                Debug.Print "Deleting col " & IcolN
            End If
 
        Next IcolN
 
    End If

[Menhir]

Quelques commentaires sur ton code

Tes EntireColum sont inutiles.

Code :

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

Columns(12).EntireColumn

Tu demandes à VBA de prendre la colonne entière... d'une colonne entière.

Tout comme les UsedRange.

Autrement dit,

Code :

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

Worksheets("CK traité").UsedRange.Columns(7).EntireColumn.Copy Worksheets("CK final").Cells(1, 2)

Peut s'écrire plus simplement :

Code :

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

Worksheets("CK traité").Columns(7).Copy Worksheets("CK final").Cells(1, 2)

Dans cette instruction :

Code :

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

    Worksheets("CK final").Range("F2:F" & dernligne2).FormulaR1C1 = "CK"

Pourquoi utiliser Formula alors qu'il n'y a pas de formule ? Tu devrais utiliser simplement Value.

le message d'erreur affiché est (impossible de coller les cellules car elles sont de forme et de taille différentes)

Sur quelle ligne se déclenche l'erreur ?
N'aurais-tu pas des cellules fusionnées dans tes feuilles ?