[XL-2000] Copie d'un tableau d'une feuille à une autre et suppression de ligne [Résolu]

[juju05]

Bonjour,

Dans un même classeur, je souhaite copier un tableau de la feuille 1 à la feuille 2 qui peut déjà contenir des lignes puis supprimer les lignes qui ont la colonne G non renseignée par "x" une fois qu'il est dans la feuille 2.

Pb: la suppression ne se fait pas. Q

Je ne vois pas d'où cela provient.

Mon code:

Code :

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
Dim wbo1 As Workbook
Dim wso1 As Worksheet, wso2 As Worksheet
 
Dim Sh As Worksheet
Dim plage1 As Range
Dim plage2 As Range
 
Dim dl1 As String
Dim dld As Long ' dernière ligne
Dim wbsd As Worksheet
 
 
   Dim I As Integer
   Dim nb_lig As Integer
 
   Set wbsd = Sheets(2)
   Set wso1 = Sheets(1)
 
   dld = wbsd.Cells(wbsd.Rows.Count, 2).End(xlUp).Row + 1
 
   With wso1
        dl1 = wso1.Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0)
        Set plage1 = wso1.Range("a4:" & dl1)
        plage1.Copy
        wbsd.Range("a" & dld).PasteSpecial Paste:=xlPasteValues
   End With
 
   ' Suppression des états non renseignés
 
   Sheets(2).Activate
 
   nb_lig = Sheets(2).Range("E65536").End(xlUp).Row
 
   MsgBox nb_lig
 
      For I = nb_lig To 4 Step -1
         MsgBox I
         If Range("G" & I).Value <> "x" Then Rows(I).Delete
      Next I

Merci d'avance.
Julien.

[mercatog]

Pourquoi transférer toutes les lignes puis supprimer celle non renseignées en colonne G.
Ci joint proposition qui permet de filtrer la 1ère feuille sur les cellules renseignées de la colonne G et de copier les lignes résultantes du filtre.

Je suppose que le ligne 3 de la 1ère feuille est celle des titres

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Test()
Dim LastLig As Long, NewLig As Long
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Sh = Worksheets(2)
NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1
With Worksheets(1)
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("G3:G" & LastLig).AutoFilter Field:=1, Criteria1:="<>", Criteria2:="<> ", Operator:=xlOr
    If .Range("G3:G" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        .Range("A4:X" & LastLig).SpecialCells(xlCellTypeVisible).Copy
        Sh.Range("A" & NewLig).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End If
    .AutoFilterMode = False
End With
Set Sh = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

Edit
Pour transférer seulement les lignes avec un x en colonne G, changer la ligne 12 de filtrage par ceci

Code :

    .Range("G3:G" & LastLig).AutoFilter Field:=1, Criteria1:="x"

[juju05]

Merci pour la réponse.

Je souhaite faire un couper de la feuille 1 vers la feuille 2.
Le script me permet de faire un copier-coller.
Que dois-je faire pour supprimer ce que j'ai copié ?

Merci d'avance.
Julien.

[mercatog]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Test()
Dim LastLig As Long, NewLig As Long
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Sh = Worksheets(2)
NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1
With Worksheets(1)
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("G3:G" & LastLig).AutoFilter Field:=1, Criteria1:="x"
    If .Range("G3:G" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        .Range("A4:X" & LastLig).SpecialCells(xlCellTypeVisible).Copy
        Sh.Range("A" & NewLig).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        .Range("A4:A" & LastLig).EntireRow.Delete
    End If
    .AutoFilterMode = False
End With
Set Sh = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

[juju05]

Merci beaucoup