Discussion :

[NEC14]

Bonjour à tous,

Voici mon problème. A l'aide des codes ci-joints je copie des données d'un tableau général vers un autre dans une autre feuille.
Une fois la copie faite, il me met après la dernière remplie, le nombre de ligne comportant des données, et ça je souhaite le supprimer mais je n'y arrive pas.
Pouvez-vous m'apporter votre aide s'il vous plait ?
Merci par avance

1er code je tape la lettre "P" en A3

Code :

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

1
2
3
4
5
6
7
8
9
10
 
Private Sub Worksheet_Activate()
If Range("A2") = "" Then
Range("A2").Select
    ActiveCell.FormulaR1C1 = "P"
    Range("A3").Select
Else
Range("A3").Select
End If
End Sub

2ème code les données sont copiées si "P" est trouvé dans la colonne "G" du tableau général

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
47
48
49
50
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastLig As Long, NewLig As Long, Nb As Long
If Target.Address = "$A$2" Then
   Union(Range("A4:H" & Rows.Count), Range("J4:K" & Rows.Count)).ClearContents
   If Target <> "" Then
      With Sheets("Général")
        .Range("A3").AutoFilter
         LastLig = .Cells(Rows.Count, "G").End(xlUp).Row
         If LastLig < 4 Then
         If .Range("A3").AutoFilter = True Then .Range("A3").AutoFilter
         Exit Sub
         End If
         With .Range("A3:N" & LastLig)
            .AutoFilter
            .AutoFilter field:=7, Criteria1:=Target
         End With
         Nb = .Range("A3:A" & LastLig).SpecialCells(xlCellTypeVisible).Count - 1
         If Nb > 0 Then
            Application.EnableEvents = False
            .Range("A4:F" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("A4")
            .Range("I4:J" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("G4")
            .Range("L4:M" & LastLig).SpecialCells(xlCellTypeVisible).Copy
            .Range("J4").PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            Application.EnableEvents = True
         End If
         .Range("A3").AutoFilter
        Range("A3").Select
      End With
      Range("A3").Select
    ActiveWorkbook.Worksheets("P").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("P").Sort.SortFields.Add Key:=Range("K4:K299"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("P").Sort.SortFields.Add Key:=Range("B4:B299"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("P").Sort
        .SetRange Range("A3:L500")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A3").Select
 
   End If
End If
AutoFitSheet
End Sub

[Theze]

Bonjour,

Dans le code posté, aucune ligne ne permet d'entrée le nombre de lignes comportant des données juste deux variables utilisées pour borner les plages :

Code :

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

1
2
3
4
 
LastLig = .Cells(Rows.Count, "G").End(xlUp).Row
'...
Nb = .Range("A3:A" & LastLig).SpecialCells(xlCellTypeVisible).Count - 1

Par contre, en fin de procédure le code appelle une autre procédure "AutoFitSheet" ou est elle ? Pour tester si c'est elle, mets là en commentaire.

[NEC14]

Bonjour,


voici le code lié à AutoFitSheet

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Public Sub AutoFitSheet()
If ActiveWorkbook Is Nothing Then Exit Sub
Dim I
If ActiveWindow.SelectedSheets.Count > 1 Then
For I = 1 To ActiveWindow.SelectedSheets.Count
ActiveWindow.SelectedSheets(I).Cells.EntireColumn.AutoFit
Next
Else
Cells.EntireColumn.AutoFit
End If
End Sub

Merci pour votre aide

[NEC14]

Bonjour,


voici le code lié à AutoFitSheet

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Public Sub AutoFitSheet()
If ActiveWorkbook Is Nothing Then Exit Sub
Dim I
If ActiveWindow.SelectedSheets.Count > 1 Then
For I = 1 To ActiveWindow.SelectedSheets.Count
ActiveWindow.SelectedSheets(I).Cells.EntireColumn.AutoFit
Next
Else
Cells.EntireColumn.AutoFit
End If
End Sub

Merci pour votre aide

Désolé, j'ai répondu sous mon pseudo du boulot. Je suis bien RENE14

[Theze]

Au boulot je suis en 2003 donc je ne peut pas tester mais c'est bizarre que ça inscrive la valeur que tu dis car je ne vois vraiment pas quelle ligne de code peut faire ça à moins que quelque chose m'échappe ???

[NEC14]

Moi non plus je ne comprends pas. J'ai l'impression que le tableau réagit comme un TCD mais sans savoir pourquoi et comment.

[NEC14]

Bonjour,

Depuis ma dernière intervention sur ce sujet, je n'ai toujours pas trouvé de solutions. Je vais refaire le fichier autrement car c'est gênant au quotidien.
Merci pour vos bons conseils.
Amicalement
René