Copie condition( j'ai déja vu la réponse de paritec mais...)

[Myth]

Bonjour,
J'ai déja vu le post de paritec qui parlait du même problème mais je n'arrive pas à comprendre comment il fonctionne. Si quelqu'un arriverai à m'expliquer .

https://www.excel-downloads.com/threads/macro-copiant-des-colonnes-sous-condition.143330/

Sinon voilà mon problème.
But : Copier les colonnes dans lesquelles la première ligne est "X". Les collers dans une nouvelle feuille excel. Que l'on nommera avec la date du jour dans le dossier dans lequel le fichier a été ouvert.
Les 2 problèmes: Le premier est que je ne trouve pas de moyen de copier les cellules à la condition de trouver un "X"
Le second problème: je ne trouve pas de moyen pour enregistrer le fichier dans le dossier d'ouverture

Je vous met ci-joint mon fichier avec mon avancement. Il ne fonctionne pas sous condition.

Voilà le code actuel

Sub ExportEnre()

'copie, créer'
Range("C:C,D,F:F,G:G").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Range("B1").Select
ActiveSheet.Paste
'enregistre'
Dim fso, Chemin, NomFichier, FichierExiste
Set fso = CreateObject("Scripting.FileSystemObject")
'//changer chemin'
Chemin = "C:\Documents and Settings\Mes documents\"
NomFichier = Format(Date, "dd-mm-yy")
NomFichier = "ReportD" & NomFichier & "_" & Format(Now, "hh-mm")
FichierExiste = IIf(fso.FileExists(NomFichier & ".xls"), True, False)

If FichierExiste = True Then
Application.Quit
End If
ActiveWorkbook.SaveAs Filename:=Chemin & NomFichier, FileFormat:=xlNormal
Range("A1").Select

End Sub


En ce qui concerne le code de Paritec

Sub copier()
Dim i&, fin&, li&, aa As Variant, a&, b&, y%, bb As Variant ' on définit les variables' Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count) 'on ajoute une feuille count'
ActiveSheet.Name = Feuil1.Cells(10, 2) & "-" & Feuil1.Cells(12, 2) ' on la nomme'

fin = Feuil2.Range("A65000").End(xlUp).Row ' ?? je suppose que c'est définir la plage'
aa = Feuil2.Range("A1:R" & fin) ' de même avec aa ??'
For i = 1 To UBound(aa) ' 'et voilà c'est a partir de cette boucle que je ne comprends plus'
If Feuil1.Cells(10, 2) = aa(i, 1) Then a = i
If Feuil1.Cells(12, 2) = aa(i, 1) Then b = i
Next i
ReDim bb(UBound(aa), 2)
bb(a, 1) = aa(a, 1): bb(b, 1) = aa(b, 1)
y = 2
For i = 2 To 18
If aa(a, i) <> "" And aa(b, i) <> "" Then
ReDim Preserve bb(UBound(aa), y)
For li = 1 To fin
bb(li, y) = aa(li, i)
Next li
End If
y = y + 1
Next i
ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(UBound(aa), y - 1)) = bb
End Sub

 

[James007]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

Bonjour,

Avec tes commentaires, je n'arrive pas à déterminer :

1. Si la macro de Paritec fonctionne et que tu cherches à comprendre comment elle fonctionne ... ou

2. Si tu cherches encore une solution à ton problème ...

A +

 

[Myth]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

J'ai mal expliqué. Alors, je cherche encore une solution à mon problème car je n'arrive pas adapter/incorporer la macro de paritec a mon fichier.

Merci d'avoir répondu,

 

[James007]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

Re,

J'ai envie de te conseiller de franchir les étapes une après l'autre ...

Avant tout, la sélection de tes Colonnes pour la copie ...

Voir le fichier test joint ...

A +

 

[Myth]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

Super merci je commence a mieux comprendre le fonctionnement. Je comprends mieux ton code.
Pour pouvoir enregistrer dans le dossier "parent" il existe un code spécifique ?

 

[James007]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

Bonjour,

Content que tu progresses dans ta compréhension ...

Pour ce qui concerne la sauvegarde, le code est générique ...

Application.DisplayAlerts = False
ThisWorkbook.SaveAs filename:=TonNomdeChemin & TonNomdeFichier & TonExtension
Application.DisplayAlerts = True

A +

 

[Myth]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

J'ai quelques petites questions sur le code.
Question 1
Je n'arrive pas bien a voir quand se fait le i+1 est-ce automatique avec la fonction next c?

Question 2
Si je le retranscris en français d'après ce que je comprends. pour i = 13

On définit c comme une range, plage comme une range i comme un nombre et j comme un nombre
Pour chaque c dans la feuil1 si c= X alors on définit j comme la colonne de c
C'est là ou j'ai pas des difficultés "
If Plage Is Nothing Then
Set Plage = Feuil1.Range(Cells(1, j), Cells(i, j))
Else
Set Plage = Union(Plage, Feuil1.Range(Cells(1, j), Cells(i, j)))
End If"
Je n'arrive pas à comprendre comment celà fonctionne.



Voilà le code en entier
Dim c As Range
Dim Plage As Range
Dim i As Long
Dim j As Long

i = 13
Feuil2.Range("A1:H" & i).ClearContents

For Each c In Feuil1.Range("A1:H1")
If c = "X" Then
j = c.Column
If Plage Is Nothing Then
Set Plage = Feuil1.Range(Cells(1, j), Cells(i, j))
Else
Set Plage = Union(Plage, Feuil1.Range(Cells(1, j), Cells(i, j)))
End If
End If
Next c
Plage.Copy Destination:=Feuil2.Range("A1")
End Sub

 

[Guest]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

Bonjour,

J'ai un peu modifié la macro pour qu'elle ne lève pas d'erreur si elle était lancée à partir d'une autre feuille que Feuil1 et ajouté des commentaires.

Sub truc()
Dim c As Range
Dim Plage As Range
Dim i As Long
Dim j As Long
i = 13
Feuil2.Range("A1:H" & i).ClearContents
 
'Travailler sur la feuille Feuil1
With Feuil1
'Balayer toutes les cellules de la plage A1:H1
For Each c In .Range("A1:H1")
If c = "X" Then
j = c.Column
'Si Plage n'a pas encore été initialisé (pas encore trouvé de "X")
If Plage Is Nothing Then
'Initialiser la plage avec la première colonne contenant X en ligne 1
'Cellule ligne 1 colonne j à cellule ligne i (13), colonne J
Set Plage = .Range(.Cells(1, j), .Cells(i, j))
 
Else
'Plage à déjà été initialisée (contient au moins cellule)
'On fait l'union de la plage existante et de la colonne en cours contenant X (cellule ligne 1 à 13)
Set Plage = Union(Plage, .Range(.Cells(1, j), .Cells(i, j)))
End If
End If
Next c
End With
Plage.Copy Destination:=Feuil2.Range("A1")
End Sub

A+

 

[Myth]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

Génial !
C'est très claire. Je comprends beaucoup mieux le code maintenant.
Merci beaucoup à vous deux.

 

[Guest]

Re : Copie condition( j'ai déja vu la réponse de paritec mais...)

Bonjour,

J'ai oublié de préciser que union lève une erreur si il n'existe pas au moins un objet range dans la plage initiale.
C'est comme essayer d'unir quelque chose à rien!
A+