Discussion :

[khroutchev]

Bonjour,
j'aimerais avoir une aide sur le code qui permet de couper et coller dans une nouvelle feuille excel une plage filtrée sur une colonne.

Mon exemple est le suivant :

La feuille 1 contient l'ensemble des données (nombre de lignes variable et nombre de colonnes allant de A à V minimum donc variable aussi).
Il faut couper et coller l'ensemble de la plage de données pour lesquelles en colonne "E" rows est égal à 9422 ou 9423.
En gros couper et coller dans la feuille 2 ces lignes (y compris la ligne d'en-tête). Et si possible donner le nom "blabla" à cette nouvelle feuille.

Je vous remerci d'avance .

Je peux joindre mon code si besoin, mais je pense que cette macro n'étant pas trop complexe mon code "faux" n'aiderait pas beaucoup.

[EngueEngue]

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
Sub toto()
dim i as long
dim k as long
dim derncol as integer
 
derncol = Feuil1.range(columns.count & 1).end(xltoleft).column
For i = 1 to derncol
Feuil2.cells(1,1)=Feuil1.cells(1,1)
next i
 
 
Feuil2.name="blabla"
 
k=2
 
For i= 2 to Feuil1.range("A" & rows.count).end(xlup).row
If Feuil1.range("E" & i) = 9422 or Feuil1.range("E" & i)= 9423 then
Feuil2.range(cells(k,1),cells(k,derncol))=Feuil1.range(cells(i,1),cells(i,derncol))
k=k+1
end if
next i
end sub

[khroutchev]

"La méthode Range de l'objet WorkSheet n'a pas fonctionné" (pour derncol) ???

[EngueEngue]

Je me suis levé du pied gauche aujourd'hui

Code :

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

derncol = Feuil1.Cells(1, Columns.Count).End(xlToLeft).Column

[khroutchev]

Il me met "Objet requis" pour la ligne Feuil2.Cells(1, 1) = Feuil1.Cells(1, 1)

[EngueEngue]

JE me suis trompé:

Code :

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

Feuil2.cells(1,i)=Feuil1.cells(1,i)

Vérifie que tu aies bien deux feuilles dans ton classeur

[Invité]

Une variante avec des requêtes SQL:

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
44
45
46
Option Explicit
 
Public Sub Traitement()
 
    Dim intCol As Integer, intRow As Integer, i As Integer, j As Integer
    Dim strfile As String, strcon As String, strSQL As String
    Dim cn As Object, rs As Object
    Dim tabdonnees As Variant
 
    With Worksheets("Feuil1")
        intCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
        intRow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range(.[A1], .Cells(1, intCol)).Copy Worksheets("Feuil2").Range("A1")
        ActiveWorkbook.Names.Add Name:="tbldonnees", RefersTo:=.Range(.[A1], .Cells(intRow, intCol))
    End With
 
    strfile = ActiveWorkbook.FullName
    strcon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strfile _
             & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
 
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
 
    cn.Open strcon
 
    'Requete SQL
    strSQL = "SELECT * FROM tbldonnees WHERE E='9422' OR E='9423'"
 
    'Ouverture de la requete
    rs.Open strSQL, cn
 
    'Recuperation de la requète
    tabdonnees = rs.getrows()
 
    With Worksheets("Feuil2")
        .Cells.Clear
        For i = 0 To UBound(tabdonnees, 2)
            For j = 0 To UBound(tabdonnees, 1)
                .Cells(i + 2, j + 1) = tabdonnees(j, i)
            Next j
        Next i
    End With
 
    ActiveWorkbook.Names("tbldonnees").Delete
 
End Sub

Classeur en PJ.

[khroutchev]

Erreur sur la ligne "rs.Open strSQL, cn"