Modifier l'extraction de ligne entière extraction col spécifique
Résolu/Fermé
A voir également:
- Modifier l'extraction de ligne entière extraction col spécifique
- Extraction video youtube - Guide
- Modifier dns - Guide
- Modifier liste déroulante excel - Guide
- Comment modifier un pdf - Guide
- Site de vente en ligne particulier - Guide
3 réponses
Gyrus
Messages postés
3334
Date d'inscription
samedi 20 juillet 2013
Statut
Membre
Dernière intervention
9 décembre 2016
523
11 juil. 2015 à 08:55
11 juil. 2015 à 08:55
Bonjour,
A+
Sub Macroextraction_2()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Col = "J" ' colonne données non vides à tester'
NumLig = 1 'alors là ca doit etre le N° de la 1er ligne de données en comptant la ligne 1 = 0 .... ?
With Sheets("1") ' feuille source'
NbrLig = .Cells(1048576, Col).End(xlUp).Row
For Lig = 1 To NbrLig 'n° de la 1ere ligne de données'
If .Cells(Lig, Col).Value = 1 Then
.Cells(Lig, 1).Resize(, 8).Copy
NumLig = NumLig + 1
Sheets("2").Cells(NumLig, 1).Insert Shift:=xlDown
'ici pour insérer ou .Paste pour coller'
End If
Next Lig
End With
End Sub
A+
A Gyrus
Est-il possible de désélectionner la zone copiée(sur la page source, la ligne copier reste active) ceci est une question facultative pas urgente. Une fois de + M6
Est-il possible de désélectionner la zone copiée(sur la page source, la ligne copier reste active) ceci est une question facultative pas urgente. Une fois de + M6
Gyrus
Messages postés
3334
Date d'inscription
samedi 20 juillet 2013
Statut
Membre
Dernière intervention
9 décembre 2016
523
13 juil. 2015 à 19:43
13 juil. 2015 à 19:43
Bonjour,
Voici le code après adaptations :
A+
Voici le code après adaptations :
Sub Macroextraction_2()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Application.ScreenUpdating = False
Col = "J" ' colonne données non vides à tester'
NumLig = 1 'alors là ca doit etre le N° de la 1er ligne de données en comptant la ligne 1 = 0 .... ?
With Sheets("1") ' feuille source'
NbrLig = .Cells(1048576, Col).End(xlUp).Row
For Lig = 1 To NbrLig 'n° de la 1ere ligne de données'
If .Cells(Lig, Col).Value = 1 Then
.Cells(Lig, 1).Resize(, 8).Copy
NumLig = NumLig + 1
Sheets("2").Cells(NumLig, 1).Insert Shift:=xlDown
'ici pour insérer ou .Paste pour coller'
End If
Next Lig
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
A+
13 juil. 2015 à 15:35