none
Creare File Diversi da un foglio usando come chiave di legame il valore presente in una cella di un altro foglio della stessa cartella

    Discussione generale

  • Ciao a tutti,

    ho adatto un codice che utilizzavo in precedenza allo scopo attuale:

    Option Explicit

    Sub EstrattoConto() Dim wk As Workbook Dim SH As Worksheet Dim sh1 As Worksheet Dim fName As String Dim aFilter As String Dim iFiltered As Long Dim i As Long Dim sFoglio As Worksheet Dim a As Range, CodCli As Range Set sFoglio = ActiveWorkbook.Worksheets("PREZZI") Set CodCli = sFoglio.Range("G8:G100") Const cSavePath As String = "C:\Users\Ry03360\Desktop\" fName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name With Application .DisplayAlerts = False .ScreenUpdating = False End With With CodCli For Each a In CodCli.Cells i = i + 1 With a End With Next a End With With SH iFiltered = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 If Not iFiltered = 0 Then ActiveSheet.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Set wk = Application.Workbooks.Add With wk Set sh1 = .Worksheets("Foglio1") sh1.Paste With sh1 .Columns(2).Delete With .Range("A1:L1") .Value = Array("Codice Cliente", "Ragione Sociale", "Agente", "Importo Nuovo Fido", _ "Decorrenza Nuovo Fido", "Saldo Contabile Attuale", "Importo Fido Precedente", _ "Decorrenza Fido Precedente", "Tipo Affidamento", "Codice Avviamento Postale", _ "Provincia Sede Legale", "Differenza Importo Fido") .Font.Bold = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False Columns("F:L").ColumnWidth = 12.29 Columns("F:L").ColumnWidth = 14.71 Columns("F:F").ColumnWidth = 12.14 Columns("F:F").ColumnWidth = 11 Columns("F:F").ColumnWidth = 10 Columns("G:G").ColumnWidth = 9.71 Columns("G:G").ColumnWidth = 11 Columns("H:H").ColumnWidth = 12.14 Columns("K:K").ColumnWidth = 11.43 Columns("K:K").ColumnWidth = 10.71 Columns("K:K").ColumnWidth = 9.29 Columns("J:L").Select Columns("N:N").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("N1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Range("N5") .Value = Array("R = FIDO DA RIPRISTINARE PERCHE' TRASCORSI 12 MESI") .Font.Bold = True End With .SaveAs Filename:=cSavePath & "Affidamenti " '& aFilter(i, 1), _ FileFormat:=xlExcel8 End With iFiltered = 0 ActiveSheet.AutoFilterMode = False End With i = i + 1 With Application .DisplayAlerts = True .ScreenUpdating = True End With Set wk = Nothing Set SH = Nothing Set sh1 = Nothing End With End If End With End Sub

    Ovviamente il risultato non è quello che voglio, che di seguito ricapitolo:

    1) il foglio BASE DATI contiene la situazione contabile di tutti i miei clienti;
    2) la chiave di legame con il foglio PREZZI è il codice cliente;
    3) il mio tentativo è quello di creare singoli file .xls in una cartella sul desktop ognuno nominato con il codice cliente e contenente la situazione contabile solo di quel cliente e solo per quelli presenti nel foglio PREZZI.

    Analizzando il codice postato, credo che la soluzione sia molto vicina, ma non la trovo.

    Potreste darmi qualche suggerimento?

    Ecco il link dove trovare il file di prova: 

    https://1drv.ms/f/s!AqPTHQbY5cF7gQHGlLTtq_x4F5ot

    Vi prego di non prestare attenzione al codice che trovate nei vari moduli.

    Grazie mille.

    Saluti,
    PDA

    martedì 26 dicembre 2017 18:53

Tutte le risposte