macro per copia valori da diversi fogli su un master

Versione Completa   Stampa   Cerca   Utenti   Iscriviti     Condividi : FacebookTwitter
matteotassi
00giovedì 8 febbraio 2018 12:40
Ciao a tutti gli utenti,

avrei bisogno di trovare una macro che mi copi da tanti fogli in una cartella sempre un determinato intervallo valori (finchè trova righe diverse da zero a partire dalla riga 5 e range delle colonne da D a G), da una scheda di ogni foglio (nominato a piacere) che si chiama sempre uguale e me li incolli in colonna su un foglio master (a partire dalla cella D35, situato sempre all'interno della stessa cartella degli altri singoli fogli).

Allo stesso tempo ad ogni azione di copia incolla, vorrei che sia formattato il range incollato, con inserimento di una doppia linea di bordo per indicare la fine di un intervallo e l'inizio di un altro.

Grazie a chiunque voglia aiutarmi
raffaele1953
00giovedì 8 febbraio 2018 17:53
Potrei farlo a condizione che alleghi un allegato
Inoltre all'interno del files metti varie spiegazioni.
Perchè nel Tuo post attuale, non ho capito nulla o quasi
matteotassi
00venerdì 9 febbraio 2018 09:11
Ecco allegati i files come esempio, ho cercato di aggiungere qualche nota in più.

Grazie mille
matteotassi
00venerdì 9 febbraio 2018 09:22
Dimenticavo, la macro andrebbe lanciata dal foglio generale di riepilogo.
GiuseppeMN
00venerdì 9 febbraio 2018 10:09
Buona giornata, Matteo;
sicuro di non poter gestire in modo diverso la Procedura?
Non conviene avere nello stesso File i Fogli di lavoro?:
-    BoQ_Computo generale
-    BoQ1 (Nome non necessariamente BoQ1)
-    BoQ2 (Nome non necessariamente BoQ2)
-    BoQ3 (Nome non necessariamente BoQ3)
-    BoQn (Nome non necessariamente BoQn)
Ogni File riguarderebbe un Progetto di costruzione e, molto probabilmente, la gestione sarebbe meno impegnativa.

Detto ciò, nel File Master, quello nel quale vengono copiati i Dati dei fari File della tua attuale struttura, non è chiara la struttura in "C12:I30"

Capisco di non inserire Dati sensibili ma:
-    Scavi
-    Sottofondo
-    ecc. ...
non mi sembrebbero Dati che ledano la Privacy della tua Azienda o dei tuoi Clienti.


Buon Lavoro.

Giuseppe
matteotassi
00venerdì 9 febbraio 2018 10:31
Salve,
purtroppo da procedura devo mantenere i files separati.

In allegato la struttura sulle celle C12-I30.
Sono un semplice raggruppamento per categorie di valori delle voci incollate sotto in modo da poterle compattare a seconda dell'esigenza.
GiuseppeMN
00venerdì 9 febbraio 2018 16:56
Buon pomeriggio, Matteo.
@matteotassi, scrive:

purtroppo da procedura devo mantenere i files separati.


A prescindere dal fatto che non dovremmo essere noi a dover seguire una Procedura palesemente contorta ma bensì cercare di modificarla, quello che crea problemi è proprio la struttura dei File che è incompatibile.

Nel File Master le colonne interessate dai Record sono nel Range C:I mentre nei File d'appoggio sono nel Range D:G; quindi le colonne "I, H e I" non hanno alcun bordo.

Nel File in allegato, troverai una proposta di soluzione di questo tipo:
Option Explicit

Sub Apri_File()
Application.ScreenUpdating = False
On Error GoTo 10
Dim URc As Long, URc2 As Long
Dim Riga As Byte, x As Byte
Dim Nome As String
Dim File As String
Const Path As String = "C:\matteotassi\Schede\"		"<<< Tua path"

    File = ActiveWorkbook.Name
    URc = Range("D" & Rows.Count).End(xlUp).Row
        If URc < 35 Then URc = 35
    Range(Cells(35, 3), Cells(URc, 3)).ClearContents
    Range(Cells(35, 4), Cells(URc, 7)).Clear
    Nome = Dir("*.xlsx")
        If Nome = "" Then Exit Sub
            While Nome <> ""
                    URc = Range("D" & Rows.Count).End(xlUp).Row + 1
                        If URc < 35 Then URc = 35
                    Riga = Riga + 1
                Workbooks.Open Filename:=Path & Nome
                    URc2 = Range("D" & Rows.Count).End(xlUp).Row
                        If URc2 < 5 Then URc2 = 5
                    Range(Cells(5, 3), Cells(URc2, 7)).Copy
                Windows(File).Activate
                    Cells(URc, 3).Select
                        ActiveSheet.Paste
                            Application.CutCopyMode = False
                Windows(Nome).Activate
                    ActiveWorkbook.Close
                Nome = Dir
            Wend
Application.ScreenUpdating = True
    Cells(35, 3).Select
10:
Application.ScreenUpdating = True
    Cells(35, 3).Select
End Sub

Poi, ovviamente, vedi tu.



Buona serata.

Giuseppe
matteotassi
00venerdì 9 febbraio 2018 17:18
Ciao,
grazie intanto della risposta.
L'ho provata nel mio caso ma non parte nulla.
Per meglio capirne il funzionamento ti allego uno zip con il master e la tua macro attivata (c'è un campo commento vuoto) e 4 fogli casuali da cui pescare dei valori.
GiuseppeMN
00venerdì 9 febbraio 2018 19:21
Buona sera, Matteo;
per poter funzionare è necessario che tu inserisca nella Directory (Cartella) indicata in:
Const Path As String = "C:\Forum#2\matteotassi\Schede\"

Puoi cambiare Directory (Esempio: "C:\matteotassi\Schede\") ma, contestulamente dovrai modificare la Costante in:
Const Path As String = "C:\matteotassi\Schede\"


In "Schede" andrai ad inserire tutti i File d'appoggio:
-    BoQ_CULV-01.xlsx
-    BoQ_CULV-02.xlsx
-    BoQ_DITCH-01.xlsx
-    BoQ_TANK_FDN-04.xlsx

Il File Master.xlsm puoi salvarlo dove ritieni più opportuno.

A questo punto dovresti ottenere quello che chiedi.

Se hai problemi possiamo chiarire tutti i dubbi in Skype; con l'impegno di condividere in Forum il risultato finale.



A disposizione.

Buona serata.

Giuseppe
GiuseppeMN
00venerdì 9 febbraio 2018 21:38
Buona sera, Matteo;
per maggior sicurezza potresti aggiungre il Comando "ChDir".
Voglio dire, prova a modificare le istruzioni:

Const Path As String = "C:\matteotassi\Schede\"     "<<< Tua path"
 
    File = ActiveWorkbook.Name


in

Const Path As String = "C:\matteotassi\Schede\"     "<<< Tua path"

    ChDir Path
        File = ActiveWorkbook.Name




A disposizione.

Buona serata.

Giuseppe
matteotassi
00giovedì 15 febbraio 2018 13:09
Ciao,
mi lasci tuo nome skype per contattarti?
GiuseppeMN
00giovedì 15 febbraio 2018 13:24
Ti ho inviato un messaggio privato (ffz) con il mio nominativo Skype.

Giuseppe
Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 01:13.
Copyright © 2000-2024 FFZ srl - www.freeforumzone.com