Modifier l'extraction de ligne entière extraction col spécifique
Résolu
bitbit
-
bitbit -
bitbit -
Bonjour, La communauté
Ce code extrait toutes la ligne. Peut on l'améliorer ? Au lieu de .Cells(Lig, Col).EntireRow.Copy qui extrait toute la ligne, je voudrais plutôt copier Col [Ax: Hx]
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, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("2").Cells(NumLig, 1).Insert Shift:=xlDown
'ici pour insérer ou .Paste pour coller'
End If
Next
End With
End Sub
Ce code extrait toutes la ligne. Peut on l'améliorer ? Au lieu de .Cells(Lig, Col).EntireRow.Copy qui extrait toute la ligne, je voudrais plutôt copier Col [Ax: Hx]
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, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("2").Cells(NumLig, 1).Insert Shift:=xlDown
'ici pour insérer ou .Paste pour coller'
End If
Next
End With
End Sub
A voir également:
- Modifier l'extraction de ligne entière extraction col spécifique
- Modifier dns - Guide
- Partage de photos en ligne - Guide
- Modifier liste déroulante excel - Guide
- Modifier story facebook - Guide
- Capture d'écran page entière - Guide
3 réponses
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+
bitbit
Bravo Gyrus, vous avez résolu mon problème. Merci
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
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+