vba création de fichiers

[ouiclem]

Bonjour,
Je suis plutôt débutant en vba excel ; je vous expose mon problème (le plus clairement possible) :

J'ai un fichier Liste.xls contenant des données sur des individus :
1 individu correspond à 1 ligne et j'ai 4 données pour chaque individu (code postal, ville, nom et prenom dans cet ordre).

NB: la liste des données débute dès la cellule A1 et il peut y avoir un nombre indéterminé d'individus (donc de lignes).

Le but est de créer 1 fichier *.xls par individu.
chaque fichier contiendra dans la colonne A les 4 données de l'individu (1 par ligne) et le nom du fichier correspondra à la donnée code postal.

j'ai déjà réalisé quelque chose (confère pièce jointe) mais des erreurs surviennent à l'exécution.

Merci par avance de vos judicieux conseils.
Clément,

 

[_Thierry]

Re : vba création de fichiers

Bonsoir Clément, le Forum

Rapidos entre deux schmilblicks Oracle, InfoMaker et autres Barbatrucs Infernaux que j'en oubli mon VBA (lol...)

En reprenant la base de ton code...

Option Explicit
Sub rec()
Dim WBSource As Workbook, WBCible As Workbook
Dim WSSource As Worksheet, WSCible As Worksheet
Dim LigneSource As Integer, Cpt As Byte, NbSheet As Byte
Dim Nom As String, Path As String
 
 
Set WBSource = ThisWorkbook
Set WSSource = WBSource.Worksheets("Liste")
Path = WBSource.Path & "\"

Application.ScreenUpdating = False
LigneSource = 2

Do While Not IsEmpty(WSSource.Cells(LigneSource, 1))
    Nom = Cells(LigneSource, 1).Value
    
    Set WBCible = Workbooks.Add
        With WBCible
            .SaveAs Path & Nom
            .Sheets(1).Name = "donnees"
            .Sheets(2).Name = "questionnaire"
        End With
    
    Application.DisplayAlerts = False
        For NbSheet = 3 To Worksheets.Count
            Sheets(NbSheet).Delete
        Next
    Application.DisplayAlerts = True
    
    Set WSCible = WBCible.Worksheets("donnees")
    
    
    For Cpt = 1 To 4
        WSSource.Cells(LigneSource, Cpt).Copy WSCible.Cells(Cpt, 1)
    Next
   
    ActiveWorkbook.Close True
    LigneSource = LigneSource + 1
Loop
Application.ScreenUpdating = True
End Sub

NB sans gestion d'erreur ...

Bonne Soirée

@+Thierry
​

 

[PascalXLD]

Re : vba création de fichiers

Bonjour

Cela fait plaisir de te relire jeune homme (je parle à Thierry 😛 )

Rapidos entre deux schmilblicks Oracle, InfoMaker et autres Barbatrucs Infernaux que j'en oubli mon VBA (lol...)

Ceci explique certainement le fait que tu nous manque un peu en ce moment

Alors bon courage à toi et bonne soirée

 

[_Thierry]

Re : vba création de fichiers

Bonjour Pascal, re Clément, le Forum

Salut à toi cher ami Pascal, et oui je suis assez débordé en ce moment et je découvre plein de nouveautés pour moi (et ce n'est pas fini, c'est que le haut de l'iceberg)

Je ne me cacherais pas en disant que quand j'ai une petite heure dispo je préfère matter un DVD qu'encore des Ordis et des problème de programmation... Mais vous me manquez tous, sachez le !

Merci pour ce petit mot en tout cas cher Pascal, ça donne du courage !

Un extrait de code pour de un peu de SQL en InfoMaker en Prime !

SELECT 'START-OF-FILE' FROM dual UNION ALL 
SELECT '#DATE DE GENERATION: '|| to_char(sysdate, 'dd/mm/yyyy hh24:mi:ss') FROM DUAL UNION ALL 
SELECT ' ' FROM dual UNION ALL 
/* Entete generale*/
SELECT op.val_bloom(:type_req, code, description) 
 FROM op.traduction  
 WHERE section = 'Entete_def'  UNION ALL  
/* Entete specifique*/
SELECT op.val_bloom(:type_req, code, description)
 FROM op.traduction 
 WHERE section = op.val_bloom(:type_req, 'ENTETE_F', ' ') UNION ALL 
SELECT ' ' FROM dual UNION ALL 
SELECT 'START-OF-FIELDS' FROM dual UNION ALL 
/*Champs à recupérer*/ 
SELECT description 
 FROM op.traduction 
 WHERE section = op.val_bloom(:type_req, 'CHAMPS', ' ') UNION ALL 
SELECT 'END-OF-FIELDS' FROM dual UNION ALL 
SELECT ' ' FROM dual UNION ALL 
SELECT 'START-OF-DATA' FROM dual UNION ALL 
/*Donnees à récupérer*/ 
SELECT source_valeur 
 FROM op.interf_conv_ligne 
 WHERE :type_req NOT IN ('TITRE', 'TAUX1', 'TAUX2', 'RMBS') 
 AND code = op.val_bloom(:type_req, 'TYPE_REQ', ' ') UNION ALL 
SELECT source_valeur 
 FROM op.interf_conv_ligne 
 WHERE :type_req = 'TAUX1' 
 AND cible_valeur ='EONIA' 
 AND code = op.val_bloom(:type_req, 'TYPE_REQ', ' ') UNION ALL 
SELECT source_valeur 
 FROM op.interf_conv_ligne 
 WHERE :type_req = 'TAUX2' 
 AND cible_valeur <>'EONIA' 
 AND code = op.val_bloom(:type_req, 'TYPE_REQ', ' ') UNION ALL 
SELECT distinct(t.code_isin)   
 FROM op.histo_fifo_solde hf, op.titre t  
 WHERE :type_req like 'TITRE' 
 AND hf.quantite <> 0 
 AND t.code = hf.titre 
 --AND t.serveur = 'B' 
 AND t.date_echeance > :date_situ UNION ALL  
SELECT distinct(op.affilie(hf.titre,'CDISIN', 'TITRES', 'op.titre'))   
 FROM op.histo_fifo_solde hf, op.titre t, op.operation_poste p, op.histo_operation ho    
 WHERE :type_req like 'RMBS' 
 AND hf.quantite <> 0 
 AND p.engagement <>'E' 
 AND hf.op_finance = ho.num_operation 
 AND ho.poste = p.code 
 AND substr(t.code, 1, 3) IN ('FCC', 'OBL', 'EMT') 
 AND t.code = hf.titre 
 AND op.affilie(hf.titre,'CDISIN', 'TITRES', 'op.titre') IS NOT NULL 
 AND t.date_echeance > :date_situ UNION ALL 
SELECT 'END-OF-DATA' FROM dual UNION ALL    
SELECT ' ' FROM dual UNION ALL 
SELECT 'END-OF-FILE' FROM dual

LOL 😉

Bien à toi, bien à vous

@+Thierry
​

 

[ChTi160]

Re : vba création de fichiers

Arffffffffffffff

Comme Pascal je profite de ce fil et je ne peux rater l'occasion , pour te Saluer ,bon courage

Amicalement
Jean Marie

 

[ouiclem]

Re : vba création de fichiers

Thierry,
Merci beaucoup pour ton aide :
- précieuse
- plus que satisfaisante...
- ... et d'une rapidité déconcertante !
Clément.