Enlever automatiquement des lignes
m
Bonjour a tous
J'ai un petit probleme avec ma base de donnée qui contient 200000 personnes, J'aimerai insérer une commande qui enlèvera automatiquement les lignes dont j'ai pas besoin
en fait j'aimerai que ca enleve automatiquement les lignes dont les colonne A et B ne contiennent pas le chiffre 35' je veux dire que au moins une des deux colonnes contient le chiffre 35 ou bien les deux, dans les autres cas ou le chiffre 35 n'est pas present faudrait qu'il l'enleve automatiquement
merci pour votre aide
Bonsoir,
Proposition à tester et à adapter suivant tes besoins.
Cdlt
Option Explicit
Public Sub SupprimeNon35()
Dim sh_1 As Worksheet, sh_2 As Worksheet
Dim Plage As Range
Dim TbBase
Dim nbLignes As Long, nbColonnes As Byte
Dim i As Long, j As Byte, x As Long
Dim TbRésultat()
Dim CellDest As Range
'------------------------------------------------------------------------------
With Application
.Calculation = False
.ScreenUpdating = False
End With
'------------------------------------------------------------------------------
Set sh_1 = Worksheets("Base de données brutes")
Set sh_2 = Worksheets("Base épurée")
sh_1.Activate
With sh_1
Set Plage = Range("A1").CurrentRegion
TbBase = Plage.Value
nbLignes = UBound(TbBase, 1)
nbColonnes = UBound(TbBase, 2)
x = 0
j = 1
For i = nbLignes To 1 Step -1
If TbBase(i, j) = 35 Or TbBase(i, j + 1) = 35 Then
x = x + 1: ReDim Preserve TbRésultat(1 To 2, 1 To x)
TbRésultat(1, UBound(TbRésultat, 2)) = TbBase(i, 1)
TbRésultat(2, UBound(TbRésultat, 2)) = TbBase(i, j + 1)
End If
Next i
End With
'------------------------------------------------------------------------------
With sh_2
Set CellDest = .Range("A1")
CellDest.Range("A1:B" & x).Value = Application.Transpose(TbRésultat)
End With
'------------------------------------------------------------------------------
With Application
.Calculation = True
.ScreenUpdating = True
End With
Set sh_1 = Nothing: Set sh_2 = Nothing
Set Plage = Nothing: Set CellDest = Nothing
End Sub