Copiare 1 foglio da diverse cartelle in una nuova cartella

[bertu81Partecipante bertu81]

Buona sera a tutti.

Sono qui a richiedere il vostro aiuto.

Vorrei creare una macro che mi copia il foglio "x ASS.TEC." presente i tutte le cartelle.

Prima di copiare  vorrei inserire tutti nella stessa cartella, il foglio è necessario applicare un filtro nella riga 9 dove la colonna C deve essere maggiore di 0.

I file copiati li vorrei inserire in una nuova cartella.

Grazie per l'auto prezioso!!

 

 

[vecchio fracSenior Moderator vecchio frac Karma: 246 pts]

Non è che sei stato molto chiaro 🙂

Inoltre la discussione è nuova, non ci sono riferimenti alla precedente e probabilmente chi legge il nuovo topic non ha file di riferimento da consultare.

In sostanza:

-allega un file su cui lavorare

- descrivi meglio l'esigenza e il risultato da raggiungere

😀

[bertu81Partecipante bertu81]

In allegato la serie di file contenenti i dati.

In un nuovo file di Excel vorrei lanciare una macro:

-per estrae dalle cartelle (in allegato) il foglio "x ASS.TEC." applicando un filtro alla riga 9 dove qualtità > 0,001, per ogni foglio un nuovo foglio

-nominare i nuovi fogli della nuova cartella con il contenuto della cella C4

-una volta finito di copiare i fogli stampa il pdf di tutta la cartella.

non ho idea di dove partire.....

 

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 246 pts]

Ecco scrivere qui è meglio così recuperiamo tutto il filo del discorso 🙂

Noto che nei fogli "x ASS.TEC" c'è una protezione del foglio. Se possibile, ma devo verificare che lo sia, ti propongo di continuare con la tecnica già vista (creazione di un recordset ADO), piuttosto che di rimuovere la protezione da codice di volta in volta.

Il resto è tutto fattibile. Per "stampa PDF di tutta la cartella" io capisco che in un unico file PDF vuoi riversare il contenuto delle schede ORDINE, BUDGET, x ASS. TEC. e VERIFICA x DOC. Se intendi escludere la pdf uno di questi fogli bisogna che lo dici 🙂

Abbi un attimo di pazienza e appena posso mi dedico. Se vedi che passa troppo tempo e non hai risposta, fammi un richiamo in privato (non mi offendo, anzi).

[vecchio fracSenior Moderator vecchio frac Karma: 246 pts]

Allora no, ho capito che vuoi estrarre il contenuto della scheda ORDINE (che in realtà è l'originale di quella riversata in x TEC ASS ma mi creano problemi le formule quindi pesco i dati da lì) di ogni file classe in un nuovo file, scheda classe per scheda classe, quindi ottenere un pdf unico.

Ecco qui il codice che lo fa 🙂

Option Explicit

Private cn As Object
Private rs As Object


Sub make_pdf()
Dim fso As Object
Dim oFile As Object
Dim p As Object
Dim s As String
Dim aborted As Boolean
Dim c As Range
Dim m As String
Dim wb As Workbook
Dim wbdest As Workbook
Dim shdest As Worksheet
Dim i As Long
    
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    cn.Provider = "MSDASQL"
    
    Application.ScreenUpdating = False
    
       
    'si può specificare un percorso iniziale ma si è vincolati a restare in questo path
    'e non si può navigare tra le cartelle, quindi attenzione all'uso:
    Set p = BrowseForFolder("Seleziona il percorso dove sono salvati i files:", ThisWorkbook.Path)
    
    Set wb = ThisWorkbook
    Set wbdest = Workbooks.Add
    
    If p Is Nothing Then
        MsgBox "Procedura annullata.", vbInformation
        aborted = True
    Else
        Set fso = CreateObject("Scripting.FileSystemObject")
        For Each oFile In fso.GetFolder(p.Self.Path).Files
            If Right(oFile.Name, 3) Like "xls" Then
            
                s = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=%1; ReadOnly=False;"
                s = Replace(s, "%1", oFile.Path)
                cn.ConnectionString = s
                cn.Open
                
                i = i + 1
                If i > wbdest.Sheets.Count Then
                    Set shdest = wbdest.Sheets.Add(after:=wbdest.Sheets(i - 1))
                Else
                    Set shdest = wbdest.Sheets(i)
                End If
                
                Set rs = cn.Execute("SELECT * FROM [ordine$n5:n5]")
                m = rs.fields(0).Name
                shdest.Name = m
                
                Set rs = cn.Execute("SELECT descrizione, um, [quantità], [note] FROM [ordine$E1:K10000] WHERE [quantità]>0")
                               
                shdest.Range("A1:D1") = Split("Descrizione UM Q.TA NOTE ")
                shdest.Cells(2, 1).CopyFromRecordset rs
                
                rs.Close
                cn.Close
            End If
        Next
    End If
    
    If aborted Then Exit Sub
    
    'ora crea il pdf nella stessa cartella
    wbdest.ExportAsFixedFormat Type:=xlTypePDF, Filename:=wb.Path & "\x tec ass.pdf - tutte le classi.pdf"
    
    Application.ScreenUpdating = True
    
    Set rs = Nothing
    Set cn = Nothing
    Set oFile = Nothing
    Set fso = Nothing
    Set p = Nothing
    
    MsgBox "Fatto.", vbInformation

End Sub



Public Function BrowseForFolder(ByVal sPrompt As String, Optional ByVal start_path As Variant = "") As Object
'alternative browseforfolder!
'Usage:
'Set s = BrowseForFolder("Seleziona la cartella:", "C:\defaultdir\")
's contiene solo il nome della cartella selezionata
's.Self.Path contiene il percorso completo della cartella selezionata

Dim oShell As Object, oFolder As Object

'     StartPath     A drive/folder path or one of the following numeric constants:
'     DESKTOP = 0,      PROGRAMS = 2,      DRIVES = 17,      NETWORK = 18,
'     NETHOOD = 19,     PROGRAMFILES = 38, PROGRAMFILESx86 = 48, Windows = 36

'se non è stato specificato un percorso iniziale, parte dal desktop
    If start_path = "" Then start_path = 0
    Set oShell = CreateObject("shell.application")
    Set oFolder = oShell.BrowseForFolder(0&, sPrompt, 0&, start_path)
    If (Not oFolder Is Nothing) Then
        Set BrowseForFolder = oFolder
    End If
    Set oFolder = Nothing
    Set oShell = Nothing
End Function

Copialo in un modulo nuovo e richiamalo o associalo a un pulsante (la routine si chiama make_pdf).

Il pdf risultante viene creato e salvato nella stessa cartella in cui si trova il file in cui hai copiato il codice.

Magari allego la versione 4 del file su cui ho lavorato, tanto per completezza. Poi questo file andrebbe un po' ripulito, ci son delle cose da sistemare dentro (a livello di codice ma forse anche di fogli, che so magari il foglio x tec ass non ti serve più se fa tutto la macro leggendo il foglio ordine).

Fai sapere eventuali problemi (spero di no).

 

Allegati:

You must be logged in to view attached files.

[bertu81Partecipante bertu81]

grazie! la macro funziona,  purtroppo non fa quello che intendevo io....

Ti allego il pdf che vorrei far generare alla macro. (1 pagina per ordine contenente nome docente classe data)

E' fattibile copiando dal foglio ordini? 

Se è un problema la protezione del foglio "x ASS.TEC", potrei togliere la protezione e farlo diventare un foglio nascosta.

GRAZIE per la disponibilità

 

non riesco ad allegare il pdf... ti ho fatto  Screenshot delle prime 2 pagine del pdf

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 246 pts]

Bene, capito, e forse sì si può fare dalla scheda Ordine (devio riguardare un po' il tutto).

Magari la prox volta che fai lo screenshot evita di tirare dentro i messaggi di Whatsapp in arrivo, così tanto per la privacy   

[vecchio fracSenior Moderator vecchio frac Karma: 246 pts]

Riallego il file versione 5. Per comodità riporto anche il codice nella parte modificata:

                With shdest
                    Set rs = cn.Execute("SELECT * FROM [ordine$n3:n3]")
                    m = rs.fields(0).Name
                    .Range("A2") = "DOCENTE"
                    .Range("C2") = m
                        
                    Set rs = cn.Execute("SELECT * FROM [ordine$n5:n5]")
                    m = rs.fields(0).Name
                    shdest.Name = m
                    .Range("A4") = "CLASSE"
                    .Range("C4") = m
                        
                    Set rs = cn.Execute("SELECT * FROM [ordine$n7:n7]")
                    m = rs.fields(0).Name
                    .Range("A6") = "DATA ESERCITAZIONE"
                    .Range("C6") = m
                    
                    .Range("A9:D9") = Split("Descrizione UM Q.TA NOTE ")
                    
                    Set rs = cn.Execute("SELECT descrizione, um, [quantità], [note] FROM [ordine$E1:K10000] WHERE [quantità]>0")
                    .Cells(10, 1).CopyFromRecordset rs
                                        
                    'cosmetica
                    .Range("A2:C2, A4:C4, A6:C6").Borders.LineStyle = xlContinuous
                    .Range("A9").CurrentRegion.Borders.LineStyle = xlContinuous
                End With

Ho aggiunto anche una parte di "cosmetica" che serve solo a mettere i bordi alle celle, tanto per farti capire che si possono anche formattare le celle come usuale prima di trasformare tutto in pdf. Ho recuperato i dati dal foglio "Ordine". Secondo me il foglio "x tec ass" si può eliminare, se era finalizzato solo a ottenere un pdf stampabile.

Allegati:

You must be logged in to view attached files.

[bertu81Partecipante bertu81]

Grazie!!! 

Dopo provo a testarla.

appena puoi, ti chiedo la cortesia di togliere le immagini del precedente post. (Con notifica whatsapp)

Grazie!!

[bertu81Partecipante bertu81]

Ho fatto un po’ di prove. 

La  Macri funziona 😃

grazie!!!

[bertu81Partecipante bertu81]

La  Macro funziona 😃 

il t9 ...

 

[vecchio fracSenior Moderator vecchio frac Karma: 246 pts]

bertu81 wrote:funziona

Meno male 🙂 fai comunque altre prove. Vedrai che i bug saltano sempre fuori 😉

[Autore]

Articoli