Excel VBA couper/collerValeur

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

N'étant pas très douée en VBA, je voudrais savoir si il est possible :
1. de faire un couper/ coller des valeurs uniquement
2 de faire en sorte qu'un filtre soit appliqué automatiquement

Je m'explique :

J'ai un fichier contenant 2 feuilles: (voir fichier joint)
Nom de la 1ère feuille = "Issue_List"
Nom de la 2ème feuille = "Issue_list_Closed"

Je voudrais (feuille "Issue_List") que quand dans la colonne "J" il y a "close" alors il coupe et colle ces données dans la feuille "Issue_list_Closed" (le couper/coller fonctionne avec la macro ci-dessous) mais pas uniquement les valeurs (ca ca ne fonctionne pas avec la mocro actuelle).
En effet, dans la feuille 1 il y a des Formats conditionnels et j'ai appliqué dans certaines cellules des validations que je ne veux pas retrouver dans la feuille 2

Serait il possible qu'il filtre ou qu'il cache automatiquement les lignes qui sont vides dans la feuille 1. (cela ne fonctionne pas dans la macro actuelle)
Par exemple en mettant le filtre sur la colonne A et en n'affichant pas les blanc. Dans la colonne A c'est en fait une série incrémentée. Si je supprime les lignes celle-ci ne s'incrémentent plus correctement et la numérotation change et ca il faut absolument l'éviter.

J'ai déjà une partie du code:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub Retire_Close() Dim i As Integer Sheets("Issue_List").Select For i = 6 To Range("A1048576").End(xlUp).Row If Cells(i, 10) = "Close" Then Range(Cells(i, 1), Cells(i, 16)).Cut Sheets("Issue_List closed").Select Range("A1048576").End(xlUp).Offset(1).Activate ActiveSheet.Paste Sheets("Issue_List").Select End If Next i End Sub
J'espère que tout ceci est clair (sourire)

D'avance je vous remercie pour les bons soins que vous porterez à cette demande

Bien à vous
E

Une proposition

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Retire_Close()
Dim Sh As Worksheet
Dim i As Long, LastLig As Long, NewLig As Long
 
Application.ScreenUpdating = False
Set Sh = Sheets("Issue_List closed")
NewLig = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row + 1
 
With Sheets("Issue_List")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = LastLig To 6 Step -1
        If .Cells(i, 10) = "Close" Then
            Sh.Rows(NewLig).Insert
            Sh.Range(Sh.Cells(NewLig, 1), Sh.Cells(NewLig, 16)).Value = .Range(.Cells(i, 1), .Cells(i, 16)).Value
            .Rows(i).Delete
        End If
    Next i
End With
Set Sh = Nothing
End Sub

28/03/2011, 22h22
carden752
Bonjour,

pourquoi ne pas utiliser un collage spécial?

Code:

PasteSpecial XlPasteType:= xlPasteValues

Pour supprimer les lignes vides, quelque chose du genre
Code:

1 2 3 4 For Each rw In Worksheets(1).Cells(1, 1) this = rw.Cells(1, 1).Value If this is Nothing Then rw.Delete Next
28/03/2011, 22h45
ella12_12

@ mercatog
Bonjour et surtout un tout grand merci.

Le problème c'est que si on supprime les lignes vides la numérotation ne se fait plus correctement.
Vous pouvez voir après avoir tourné la macro on à 2 lignes qui s'appellent 9 et deux lignes qui s'appellent 10.
De plus lorsque j'insére des donnée dans ligne suivante celle-ci prend le numéro 10. C'est pour cela que j'imaginais plutot un filtre automatisé par une macro et qui n'afficherai pas les blanc

Un tout grand merci

E

@ carden752
Bonsoir,

Si j'ajoute ce code en ligne 17

Code:

ActiveSheet.PasteSpecial XlPasteType:=xlPasteValues

Cela ne fonctionne pas.

Et il ne faut surtout pas supprimer les lignes car alors la numérotation dans la colonne A ne fonctionne plus.

Un tout grand merci pour votre attention

Bien à vous
E

Pour mettre une numérotation automatique, mets ce code dans le module de la feuille "Issue_List" (évènement Change)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
Dim N As Long
 
N = Application.Max(Range("A:A"), Sheets("Issue_List Closed").Range("A:A"))
If Target.Column = 2 And Target.Row > 5 Then
    If Target.Offset(0, -1).Value = "" Then
        Application.EnableEvents = False
        Target.Offset(0, -1).Value = N + 1
        Application.EnableEvents = True
    End If
End If
End Sub

Le code précédent pourra aussi s'écrire

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Retire_Close()
Dim Sh As Worksheet
Dim i As Long, LastLig As Long, NewLig As Long
 
Application.ScreenUpdating = False
Set Sh = Sheets("Issue_List closed")
NewLig = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row + 1
 
With Sheets("Issue_List")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = LastLig To 6 Step -1
        If .Cells(i, 10) = "Close" Then
            Sh.Range(Sh.Cells(NewLig, 1), Sh.Cells(NewLig, 16)).Value = .Range(.Cells(i, 1), .Cells(i, 16)).Value
            .Rows(i).Delete
            NewLig = NewLig + 1
        End If
    Next i
End With
Set Sh = Nothing
End Sub