"publipostage" excel vers excel

lulu502

XLDnaute Nouveau
Bonjour,

Je me permets de vous solliciter car j'ai beau chercher sur le forum, essayer de faire des macros et autres, je n'y arrive pas.

J'ai 2 fichiers, ma base de données (nom de propriétaire, prénom, adresse, et autres informations) et un document type.
Je souhaiterais que les informations pour chaque propriétaire de ma base de données viennent s'intégrer dans mon document type.
Ensuite, je souhaiterais créer un bouton qui permet d'ouvrir un nouveau fichier excel, avec par onglet le document concernant chaque propriétaire.

je mets à votre disposition les pièces jointes.

J'espere que quelqu'un pourra m'aider.

Merci d'avance
 

Pièces jointes

  • base de données.xls
    33 KB · Affichages: 423
  • document type.xls
    27.5 KB · Affichages: 429
  • base de données.xls
    33 KB · Affichages: 434
  • base de données.xls
    33 KB · Affichages: 431

Sequoyah

XLDnaute Nouveau
Bonjour fjio,
on pourrait utiliser la colonne Bon de commande qui contient des valeurs uniques
pour les quatre derniers caractères

VB:
With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\" & Right(v(i, 6), 4) & ".xlsx", FileFormat:=xlWorkbookDefault
        .Close
End With
ou bien remplacer le caractère interdit "/" dans les noms de fichiers par "-"
Code:
With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\" & Replace(v(i, 6), "/", "-") & ".xlsx", FileFormat:=xlWorkbookDefault
        .Close
End With
 

fjio

XLDnaute Nouveau
Oui c'est ce a quoi je pensais intégrer bon de commande dans le nom, merci beaucoup pour les solutions et le code

j'ai résolu les clear contents


VB:
Sub test()

    Dim v As Variant
    Dim i As Long, lastRow As Long
    Dim WksSuivi As Worksheet, WksAP As Worksheet, WksCP As Worksheet
 
    Set WksSuivi = ThisWorkbook.Sheets("Suivi Transfert")
    Set WksAP = ThisWorkbook.Sheets("AP-AE")
    Set WksCP = ThisWorkbook.Sheets("CP")
 
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .DisplayAlerts = False
    End With

    lastRow = WksSuivi.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    'Stocker les valeurs dans une variable tableau (Array)
    v = WksSuivi.Range("A1:S" & lastRow).Value
 
    For i = 2 To lastRow
        WksAP.Range("A6").Value = v(i, 9) 'Colonne I Programme
        WksAP.Range("B6").Value = v(i, 10) 'Colonne J AP
        WksAP.Range("G6").Value = v(i, 14) 'Colonne N Montant
        WksAP.Range("A22") = v(i, 6) 'Colonne F BDC
        WksAP.Range("C22") = v(i, 8) 'Colonne E Objet
        WksAP.Range("B23") = v(i, 2) 'Colonne B Direction Origine
        WksAP.Range("D23") = v(i, 1) 'Colonne A direction Transfert
        WksAP.Range("C24") = v(i, 3) 'Colonne C contact transfert
        WksAP.Range("B19") = v(i, 7) 'Colonne C fournisseur
        WksAP.Range("H19") = v(i, 5) 'Colonne C evenement
        WksAP.Range("N23").Value = Format(Now, "mm/dd/yyyy") 'Colonne C date
        WksAP.Range("I20").Value = v(i, 14) 'Colonne N Montant talon
        WksCP.Range("A7").Value = v(i, 9) 'Colonne I Programme
        WksCP.Range("J7").Value = v(i, 14) 'Colonne N Montant
        WksCP.Range("B7").Value = v(i, 12) 'Colonne N LC
        WksCP.Range("D7").Value = v(i, 13) 'Colonne N Montant
     
    Sheets(Array("AP-AE", "CP")).Copy
 
    With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\" & "Fiche TC_AE_CP " & Format(i - 1, "0000") & ".xlsx", FileFormat:=xlWorkbookDefault
        .Close
    End With
   
    With WksAP
        .Range("A6").ClearContents
        .Range("B6").ClearContents
        .Range("B6").ClearContents
        .Range("G6").ClearContents
        .Range("A22").ClearContents
        .Range("C22").ClearContents
        .Range("B23").ClearContents
        .Range("D23").ClearContents
        .Range("C24").ClearContents
        .Range("B19").ClearContents
        .Range("H19").ClearContents
        .Range("N23").ClearContents
        .Range("I20").ClearContents
        .Cells(22, 3).MergeArea.ClearContents
        
          End With
      
        With WksCP
        .Range("A7, J7, B7, D7").ClearContents
        .Cells(22, 3).MergeArea.ClearContents
             
    End With
   
    Next i
 
    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic
        .DisplayAlerts = True
    End With
 
End Sub
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 247
Messages
2 086 590
Membres
103 247
dernier inscrit
bottxok