You are here:---Rispondi a: [RISOLTO] Importare alcune colonne da foglio esterno
Rispondi a: [RISOLTO] Importare alcune colonne da foglio esterno2019-07-09T21:18:04+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Importare alcune colonne da foglio esterno Rispondi a: [RISOLTO] Importare alcune colonne da foglio esterno

sidsid
Moderatore
    Post totali: 718

    Intanto ti mando il codice da mettere in un modulo standard del file Riesume.
    Si presuppone che il file “Produz_forum” sia aperto; se non lo è aprilo.
    Se funziona bene adattiamo il tutto con l’apertura del file del mese.

    Sub IMPORTA()
    Dim wbMaster As Workbook, wbSlave As Workbook
    Dim wsMaster As Worksheet, wsSlave As Worksheet
    Dim j As Long, nIncr As Long
    Dim vMatrix() As Variant, vTabella As Variant
    Dim t As Date
    
    Set wbMaster = ThisWorkbook
    Set wsMaster = wbMaster.Sheets("Riesume")
    Set wbSlave = Application.Workbooks("Produz_forum.xlsx")
    Set wsSlave = wbSlave.Sheets("LUGLIO_19")
    t = Time
    
    vTabella = wsSlave.Range("B5:Q" & ActiveSheet.UsedRange.Rows.Count)
    
    For j = LBound(vTabella) To UBound(vTabella)
        If vTabella(j, 1) <> vbNullString Then
            nIncr = nIncr + 1
            ReDim Preserve vMatrix(1 To 6, 1 To nIncr)
            vMatrix(1, nIncr) = vTabella(j, 1)
            vMatrix(2, nIncr) = vTabella(j, 2)
            vMatrix(3, nIncr) = vTabella(j, 4)
            vMatrix(4, nIncr) = vTabella(j, 5)
            vMatrix(5, nIncr) = vTabella(j, 16)
            vMatrix(6, nIncr) = wbSlave.Name
        End If
    Next j
    
    vMatrix = Application.Transpose(vMatrix) 'traspongo la matrice creata
    With wsMaster
        .Range("A2:F" & Rows.Count).Clear 'pulisco il foglio master
        .Range("A2:F" & UBound(vMatrix) + 1) = vMatrix 'scarico la matrice nel foglio
        .Range("A:F").Columns.AutoFit 'adatto le colonne al testo
    End With
    MsgBox Format(Time - t, "HH:MM:SS"), vbInformation, "CODICE ESEGUITO IN....."
    
    Set wbMaster = Nothing
    Set wsMaster = Nothing
    Set wsMaster = Nothing
    Set wsSlave = Nothing
    
    End Sub

    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