You are here:---Rispondi a: [RISOLTO] Fusione tre archivi in uno con scambio colonne
Rispondi a: [RISOLTO] Fusione tre archivi in uno con scambio colonne2019-05-09T10:44:27+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Fusione tre archivi in uno con scambio colonne Rispondi a: [RISOLTO] Fusione tre archivi in uno con scambio colonne

BySalvBySalv
Amministratore del forum
    Post totali: 477

    Ciao Paolots, ecco la macro che fa il lavoro

    Sub Trasferisci()
    Dim r, c, k, x, y, z, d, HH, rng, Risp, ind, ind2, wk, sh, Wk0 As Workbook, Sh0 As Worksheet
    
    Set Wk0 = ActiveWorkbook
    Set Sh0 = Worksheets("Foglio1")
    ind = ActiveWorkbook.Path
    Sh0.Activate
    Application.ScreenUpdating = False
    r = Sh0.Cells(Rows.Count, 1).End(xlUp).Row
    Risp = MsgBox("Attenzione! elimino la ricerca precedente, altrimenti verranno accodati", vbInformation + vbYesNo, "Gestione dati")
    If Risp = 6 Then Sh0.Range("A2:H" & r).ClearContents: k = 2 Else k = Sh0.Cells(Rows.Count, 1).End(xlUp).Row + 1
    r = Sh0.Cells(Rows.Count, 27).End(xlUp).Row
    HH = Sh0.Range("AA2:AB" & r)
    Application.DisplayAlerts = False
    For x = 1 To UBound(HH)
        wk = HH(x, 1)
        sh = HH(x, 2)
        ind2 = ind & "\" & wk
        Workbooks.Open Filename:=ind2
        Sheets(sh).Select
        r = Cells(Rows.Count, 1).End(xlUp).Row
        rng = Range("A1:H" & r)
        Workbooks(wk).Close
        For y = 2 To UBound(rng)
            For z = 1 To UBound(rng, 2)
                d = rng(1, z)
                Select Case d
                    Case "un": c = 1
                    Case "du": c = 2
                    Case "tr": c = 3
                    Case "qu": c = 4
                    Case "ci": c = 5
                    Case "a1": c = 6
                    Case "a2": c = 7
                    Case "a3": c = 8
                End Select
                Sh0.Cells(k, c) = rng(y, z)
            Next z
            k = k + 1
        Next y
    Next x
    Sh0.Activate
    Application.ScreenUpdating = True
    Cells(1, 1).Select
    End Sub

    Ricorda che i file devono stare tutti nella stessa cartella, altrimenti non riesce a trovarli.
    i nomi dei file da aprire si trovano alla colonna “AA” del foglio1 del file “Output”, ho messo il nome del file con l’estensione ed anche il nome del foglio dove sono i dati da riportare, se devi cambiarli devi cambiarli nelle colonne “AA-AB”, i file possono essere anche più di 3 basta aggiungerli.
    un ultima cosa le intestazioni mi raccomando che siano uguali, perche nei file che hai inserito nel file “F1” la sigla “du” era senza Spazi negli altri 2 file la sigla era “du ” con lo spazio dopo, quindi non riusciva a riportare i dati perche sono diverse.

    ti allego anche il file con la macro.
    http://www.filedropper.com/output_1

    Ciao By Sal (8-D

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi