[Ref 92621] Excel-VBA Rechercher puis copier plusieurs ligne dans un nouveau classeur

[Aboutblank]

Bonjour,

cela fait quelques jours que je cherche à programmer un module sur Excel mais étant novice en VBA, j'ai trouvé la forme générale du programme et la pluparts des fonctions a utiliser mais je galère sur la syntaxe exact.

J'ai besoin de créer un programme qui ferait ceci:
( De base j'ai un ClasseurSource avec 3 feuilles ( F1, F2, F3))

POUR chaque ligne (compteur i) FAIRE

     SI ClasseurSource.F1.ColonneF contient la chaine de caractère "aspv" 
          && ColonneAD contient NULL ALORS

          Créer un classeur au format CSV avec le nom ( ClasseurSource.F1.Lignei.ColonneG & ClasseurSource.F1.Lignei.ColonneJ & ClasseurSource.F1.Lignei.ColonneF".CSV")
          Copier la ligne du ClasseurSource dans le nouveau Classeur créé. ( Excepté la dernière ligne)
          Enregistrer le classeur créé à un endroit précis ( exemple chemin: C:\Intel\Logs\)

     end if
     i=i+1

end FOR

Ca ne me paressait pas très compliqué de premier abord mais la syntaxe Excel n'est pas mon fort.
Merci d'avance à celui ou ceux qui voudront bien m'aider à avancer. ^^

 

[drul]

Salut, la base:

Sub test()
Dim i As Long
For i = 1 To Application.Rows.Count ' il serait mieux de déterminer le nombre de ligne à évaluer que de tout lire, ça va prendre des plombes ...
    If (InStr(1, Sheets("F1").Cells(i, "F").Value, "aspv") > 0) And (Sheets("F1").Cells(i, "AD").Value = "") Then
       'ici faut qu'on discute ...
    End If
    
Next
End Sub

Absolument besoin d'un nouveau classeur ? (une worksheet peut être sauvé comme un fichier csv)
La dernière ligne ne doit pas être évaluée ?
Comment comptes tu déterminé quel est la dernière ligne ? y a t'il une colonne qui a toujours des données ?
Les classeurs/feuilles crées doivent-ils rester ouvert ?
le "aspv" est en minuscule ? intéressé pas la casse ?

 

[Aboutblank]

Salut,

merci pour ta réponse drul.

For i = 1 To Application.Rows.Count ' il serait mieux de déterminer le nombre de ligne à évaluer que de tout lire, ça va prendre des plombes ...

Le problème c'est que de nouvelles lignes s'ajoutent tous les jours. Le programme doit justement traiter, les lignes non traitées ( donc souvent nouvelles) et qui correspondent aux autres critères. Du coups, la valeur max dynamique est obligatoire. Mais je ne savais pas sur quel objet je devais appliquer la fonction ".rows.count". ^^

Absolument besoin d'un nouveau classeur ? (une worksheet peut être sauvé comme un fichier csv)

Non, il faut juste créer un .csv ( avec un nom spécifique en fonction de la ligne copiée) et qui contient la ligne. Mais il ne faut pas ajouter une feuille au classeur source ( Ou à moins de la supprimer juste après. Je ne sais pas ce qui est le mieux)

La dernière ligne ne doit pas être évaluée ?
Comment comptes tu déterminé quel est la dernière ligne ? y a t'il une colonne qui a toujours des données ?

Si, excuse moi, c'était un mémo perso mal écrit. >< En fait c'est juste la colonneAD qui ne doit pas être copiée. ( C'est celle qui me permet de noter si la ligne est traitée ou non. D'ailleurs, il faudra que je pense à ajouter "T" dans cette colonne quand j'ai traité une ligne dans la boucle IF. Du coups, si la colonneAD est vide, c'est le programme n'a pas encore traité cette ligne et si il a un "T", c'est qu'elle l'a déjà été.

Les classeurs/feuilles crées doivent-ils rester ouvert ?

Le classeurSource doit resté ouvert alors que le .csv créé non.

le "aspv" est en minuscule ? intéressé pas la casse ?

En minuscule "normalement" ^^ mais vu que c'est rentré à la main, je préfère que la condition ne soit pas sensible à la casse à choisir. ^^

Merci bcp de m'aider.

 

[drul]

La taille dynamique c'est pas un problème, faut juste colonne qui contient toujours une donnée, ensuite on peut faire:

dim derLigne as long
derLigne = Sheets("F1").Cells(Application.Rows.Count, "une colonne qui qui contient toujours une donnée").End(xlUp).row
for i= 1 to derLigne
 '...

N.B. on peut faire la même chose pour la première ligne en utilisant la collone "AD" ...


ce qui nous donne:

Sub test()
Dim i As Long
Dim premLigne As Long
Dim newWbook
Dim newSheet As Worksheet
Dim sourceSheet As Worksheet

Set sourceSheet = ActiveWorkbook.Sheets("F1")
premLigne = sourceSheet.Cells(Application.Rows.Count, "ad").End(xlUp).Row
Set newWbook = Application.Workbooks.Add

For i = premLigne To Application.Rows.Count

    If (InStr(1, LCase(sourceSheet.Cells(i, "F").Value), "aspv") > 0) And (sourceSheet.Cells(i, "AD").Value = "") Then
       Set newSheet = Sheets.Add
       sourceSheet.Range(sourceSheet.Cells(i, "a"), sourceSheet.Cells(i, "ac")).Copy newSheet.Range("A1")
       sourceSheet.Cells(i, "AD").Value = "T"
       newSheet.SaveAs Filename:="c:\toto" & i & ".csv", FileFormat:=xlCSV, Local:=True ' pour le nom de fichier, je te laisse voir.
       'as-tu besoins de remplacer des fichiers ? ici tu auras un prompt a chaque save si le fichier existe déjà, mais on peu forcer l'overwrite si tu le désires ...
       
       
    End If

Next
newWbook.Saved = True
newWbook.Close
End Sub

 

[Aboutblank]

'as-tu besoins de remplacer des fichiers ? ici tu auras un prompt a chaque save si le fichier existe déjà, mais on peu forcer l'overwrite si tu le désires ...

Non, les fichiers créé son unique. Et avec la génération du nom via les colonnes des lignes, leur nom est une quasi clé primaire. ^^
Ca a l'air évident quand je relis ce que tu as écris.

 

[drul]

Alors ça devrait le faire....

N.B. une version un peu plus "propre"

Sub test()
Dim i As Long
Dim premLigne As Long
Dim newSheet As Object
Dim sourceSheet As Worksheet

Set sourceSheet = ActiveWorkbook.Sheets("F1")
premLigne = sourceSheet.Cells(Application.Rows.Count, "ad").End(xlUp).Row


For i = premLigne To 10 'reste à déterminer cette valeure ...

    If (InStr(1, LCase(sourceSheet.Cells(i, "F").Value), "aspv") > 0) And (sourceSheet.Cells(i, "AD").Value = "") Then
       Set newSheet = CreateObject("Excel.Sheet")
       sourceSheet.Range(sourceSheet.Cells(i, "a"), sourceSheet.Cells(i, "ac")).Copy newSheet.Sheets(1).Range("A1")
       sourceSheet.Cells(i, "AD").Value = "T"
       newSheet.SaveAs Filename:="c:\toto" & i & ".csv", FileFormat:=xlCSV, Local:=True
       Set newSheet = Nothing
       
    End If

Next

End Sub

 

[Aboutblank]

Encore merci pour ton aide.

For i = premLigne To 10 'reste à déterminer cette valeure ...

Application.Rows.Count ne convient pas ? Vu que le but est de balayer toutes les lignes du classeurSource pour voir si elles ont étaient traitées et si elles respectent les conditions ? ( Du coups ça balayerait de la première à la dernière ligne)

 

[drul]

ça marchera, mais c'est lent et inefficace.
tu n'as pas une colonne qui contient assurément une donnée ?

 

[Aboutblank]

Salut, désolé je suis un peu long à répondre.

La colonne A contient toujours une date.

 

[drul]

alors:

Sub test()
Dim i As Long
Dim premLigne As Long
Dim derLigne As Long
Dim newSheet As Object
Dim sourceSheet As Worksheet

Set sourceSheet = ActiveWorkbook.Sheets("F1")
premLigne = sourceSheet.Cells(Application.Rows.Count, "ad").End(xlUp).Row
derLigne = sourceSheet.Cells(Application.Rows.Count, "a").End(xlUp).Row

For i = premLigne To derLigne

    If (InStr(1, LCase(sourceSheet.Cells(i, "F").Value), "aspv") > 0) And (sourceSheet.Cells(i, "AD").Value = "") Then
       Set newSheet = CreateObject("Excel.Sheet")
       sourceSheet.Range(sourceSheet.Cells(i, "a"), sourceSheet.Cells(i, "ac")).Copy newSheet.Sheets(1).Range("A1")
       sourceSheet.Cells(i, "AD").Value = "T"
       newSheet.SaveAs Filename:="c:\toto" & i & ".csv", FileFormat:=xlCSV, Local:=True
       Set newSheet = Nothing
       
    End If

Next

End Sub

 

[Aboutblank]

Merci ^^
Je vais le tester sur mon xls voir ce que ça donne.

Je voudrais ajouter une condition dans la boucle IF.
Si la colonne R est non vide.
Est-ce-que Not IsEmpty(Range("R" & i)) fonctionnerait ? Ou y a t -il mieux ?

 

[drul]

Non, isEmpty vérifie si une variable est initialisée ou non, pas si une range est vide ...

Vous devez être connecté pour voir les liens.

toi tu peux simplement faire

(Range("R" & i).value <> "")

 

[Aboutblank]

Je viens de tester, ça fonctionne et le programme en lui même aussi.
J'ai juste du modifier: "Set sourceSheet = ActiveWorkbook.Sheets("F1")
"par "Set sourceSheet = ActiveSheet".
Apparemment il ne trouvait pas la feuille.

 

[drul]

farpait

 

[Aboutblank]

Salut drul,

je me permet de revenir vers toi pour un autre problème de syntaxe toujours sur le même programme que j'ai quelque peu développé.

Voici le morceaux qui me pose problème:

p = 1                
Do                        
	Set newSheet = CreateObject("Excel.Sheet")                             
        sourceSheet.Range(sourceSheet.Cells(j, "A"), sourceSheet.Cells(j, "AC")).Copy newSheet.Range(newSheet.Cells(p, "A"), newSheet.Cells(p, "AC"))
	sourceSheet.Cells(j, "AD").Value = "T"
	j = j + 1
	p = p + 1
Loop While (sourceSheet.Cells(j - 1, "F").Value = sourceSheet.Cells(j, "F").Value)

C'est cette ligne qui a une erreur de syntaxe mais je n'arrive pas à la localiser, je dois surrement appliquer une fonction au mauvaise objet:

sourceSheet.Range(sourceSheet.Cells(j, "A"), sourceSheet.Cells(j, "AC")).Copy newSheet.Range(newSheet.Cells(p, "A"), newSheet.Cells(p, "AC"))

Je cherche à copier plusieurs lignes ( De la colonne A jusqu'à AC) dans mon classeur. D'où la variable p qui retient la ligne.

Ca me retourne une erreur 438: proriété ou méthode non géré par cet objet.

Pourrais-tu m'aider stp ? Sais-tu si il existe une fonction pour ajouter une ligne après la dernière ligne d'un classeur ce qui serait plus simple.

 

[drul]

"newSheet.Sheets(1).gngna" (les 3 fois)

et Non excel ne sais pas quelle est la "dernière" ligne ...

 

[Aboutblank]

Niquel. Merci

J'ai été trompé par le "sheet" dans le nom des 2 variables. J'ai pas remarqué que ce n'était pas le même objet.

 

[drul]

Ouais c'est un peu vicelard, je t'invite à changer de la sorte:

Dim xlsObj As Object
Dim newSheet As Worksheet

'...

Set xlsObj = CreateObject("Excel.Sheet")
Set newSheet = xlsObj.Sheets(1)

Ce serait moins trompeur et newsheet serait vraiment une "worksheet"

 

[Aboutblank]

merci