XL 2013 Copie de colonne sous condition

[Pluce1]

Bonjour,

Je cherche à savoir comment copier coller certaines colonnes avec une condition.

Je m'explique:

J'ai un fichier "Base propo" qui contient plus de 40 colonnes, je voudrais trouver une macro qui copie les colonnes A à X, en ne prenant que les lignes pour lesquelles la colonne X est non vide. Pour l'instant j'ai la macro suivante:

Sub Copier_autre()
'
' Copier_autre Macro
'
Dim C As Range
Dim LigneAjout As Long
With Workbooks("Base propo unique v2 2015.xlsm").Worksheets("Base Propo")
For Each C In .Range("X3:X" & .Range("X" & Rows.Count).End(xlUp).Row)
If Not IsEmpty(C) Then
LigneAjout = Workbooks("Suggestion eco emballage.xlsx").Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
C.EntireRow.Copy Workbooks("Suggestion eco emballage.xlsx").Worksheets("Feuil1").Range("A" & LigneAjout)
End If
Next C
End With
End Sub



Cette macro marche bien mais me copie toute la ligne à cause du EntireRow, or quand je change pour mettre Range("A:X") il y a sytématiquement une erreur.

Quelqu'un pourrait-il m'aider?

Merci,

Pluce1

 

[Lone-wolf]

Re : Copie de colonne sous condition

Bonjour Pluce1 et bienvenue sur XLD

Tu voudrais bien jeter un oeil (pas les deux sinon tu ne vois rien ) à ma signature? Tu comprendras.

Sinon:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Feuille source
Range("a1:x37").AutoFilter Field:=24, Criteria1:="><", Operator:=xlAnd
Cells.SpecialCells(xlVisible).Copy Sheets("Destination").Range("a1")
End Sub

'ET POUR SUPPRIMER LE FILTRE

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("a1:x37").AutoFilter
End Sub

 

[Pluce1]

Re : Copie de colonne sous condition

Merci de ta réponse Lone-wolf,

Comme demandé voilà des exemples de fichiers, le fichier source est test BP, celui de destination est "suggestion éco emballage".

Merci pour ton code mais je ne vois pas comment l'intégrer à ma macro.

 

[Lone-wolf]

Re : Copie de colonne sous condition

Re,

qu'est-ce que tu utilise comme version Excel ? Parce que les .xlsx ne prennent pas en charge les macros, en tout cas chez moi.

 

[Pluce1]

Re : Copie de colonne sous condition

J'utilise Excel 2013.

 

[Lone-wolf]

Re : Copie de colonne sous condition

Re,

Si ta macro fonctionne, alors modifie la macro comme ceci; et d'après ta macro les deux classeurs sont ouverts. C'est juste?

J'ai copié d'une feuille à une autre, pas d'un classeur à un autre.

For i = 3 To Range("a65536").End(xlUp).row
If Cells(i, 24) <> "" Then
                                                'feuille de destination
Range(Cells(i, 1), Cells(i, 24)).Copy Feuil2.Range("a65536").End(xlUp)(2)
End if
Next i

 

[Pluce1]

Re : Copie de colonne sous condition

Re,

Oui mes deux classeurs sont ouverts.

Tu voulais dire modifier comme ça?

Dim C As Range
Dim LigneAjout As Long
With Workbooks("Base propo unique v2 2015.xlsm").Worksheets("Base Propo")
For Each C In .Range("X3:X" & .Range("X" & Rows.Count).End(xlUp).Row)
If Not IsEmpty(C) Then
LigneAjout = Workbooks("Suggestion eco emballage.xlsx").Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
For i = 3 To Range("a65536").End(xlUp).Row
If cells(i, 24) <> "" Then
'feuille de destination
Range(cells(i, 1), cells(i, 24)).Copy Workbooks("Suggestion eco emballage.xlsx").Worksheets("Feuil1").Range("a65536").End(xlUp)(2)
End If
Next i
End If
Next C
End With
End Sub


Il ne se passé rien et aucune erreur n'est détectée mais je suppose que j'ai mal suivi ton conseil.

Je nes ais pas siça a un impact mais mon fichier contient plus de 20 000 lignes.

 

[Lone-wolf]

Re : Copie de colonne sous condition

Re,

voici la macro complète à mettre dans le module de la feuille Base propo.

EDIT: avant d'inserer cette macro, enregistre tes classeurs avec l'extension .xlsm

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer, fichier As String
fichier = ThisWorkbook.Path & "\Suggestion eco emballage.xlsm"
Workbooks.Open fichier
Application.ScreenUpdating = False
For i = 3 To Range("a65536").End(xlUp).Row
If Cells(i, 24) <> "" Then
Range(Cells(i, 1), Cells(i, 24)).Copy ActiveWorkbook.Sheets("Feuil1").Range("a65536").End(xlUp)(2)
End If
Next i
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Cancel = True
End Sub

'A rajouter dans le classeur de destination

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
End Sub

 

[Pluce1]

Re : Copie de colonne sous condition

Excel ne reconnait le Private Sub, ça lui pose un problème et quand je retire le private il me fait erreur de compilation erreur de syntaxe et dans la ligne
Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
le "As" de "Target As Range" il me dit séparateur )( attend

Je ne comprend pas pourquoi il faut avoir recours au private sub et pourquoi il faut deux macros alors qu'avec une seule ça marchait presque.

 

[Lone-wolf]

Re : Copie de colonne sous condition

Re,

As-tu changer les extensions en . xlsm? Sinon, met la macro dans un module standard

Note: avec ThisWorkbook.Path, les classeurs doivent être dans le même dossier
sinon "C:\Users\Ton Nom\Mon Dossier\Suggestion eco emballage.xlsm"

Sub Copier()
Dim i As Integer, fichier As String

Application.ScreenUpdating = False
fichier = ThisWorkbook.Path & "\Suggestion eco emballage.xlsm"
Workbooks.Open fichier

With ThisWorkbook.Sheets("Nom de la feuille")
For i = 3 To .Range("a65536").End(xlUp).Row
If .Cells(i, 24) <> "" Then
.Range(.Cells(i, 1), .Cells(i, 24)).Copy ActiveWorkbook.Sheets("Feuil1").Range("a65536").End(xlUp)(2)
End If
Next i
End With

Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[Pluce1]

Re : Copie de colonne sous condition

Bonjour,

Ca marche !! Merci beaucoup pour ton aide et ta patience !! A la fin de l'execution il m'affiche "erreur 13 imcompatibilité de type" mais tant que ça fonctionne c'est pas grave =)

Encore un énorme merci =)