VBA Filtro Tavolo e Copia Sottoinsieme di Colonne per Appunti

Sto cercando di copiare automaticamente un sottoinsieme di righe e colonne di una tabella di origine negli appunti per l’uso in altre applicazioni. Sto creando il filtro sull’intestazione della tabella e un filtro per le righe correttamente, ma non so come poi selezionare il sottoinsieme di colonne nell’ordine che voglio. La tabella di origine Colonne A – L e voglio copiare le Colonne C, I, H e F in ordine agli appunti dopo l’applicazione del filtro. Un po ‘ di codice (meno la parte di copia) è riportato qui di seguito.

Sub exportExample()
    Dim header As Range
    Dim srcCol As Range

    Set header = [A5:L5]

    header.AutoFilter
    header.AutoFilter 12, "Example", xlFilterValues

    'Copy out columns C, I, H and F of the resulting table in that order
End Sub

Riesco a capire come copiare le colonne ma non riesco a capire come farli nell’ordine che voglio. Qualsiasi aiuto è molto apprezzato! Grazie!

  • potrebbe essere necessario copiare le loro colonne nell’ordine che si desidera su di un’altra area del foglio (o un nuovo foglio), quindi copiare tutta la gamma.

 

2 Replies
  1. 2

    È ciò che stai cercando? Ho commentato il codice in modo che si non dovrebbe avere alcun problema di comprensione.

    LOGICA:

    1. Filtrare i dati
    2. Creare una Temp Foglio
    3. Copiare i dati filtrati in temp foglio
    4. Eliminare inutili colonne (A,B,D,E,G,J,K,L)
    5. Riorganizzare le colonne rilevanti (C,F,H,I) C,I,H e F
    6. Eliminare Temp Foglio alla fine (IMP: Leggere le note alla fine del codice)

    CODICE (Provato E Testato)

    Option Explicit
    
    Sub Sample()
        Dim ws As Worksheet, wsTemp As Worksheet
        Dim rRange As Range, rngToCopy As Range
        Dim lRow As Long
    
        '~~> Change this to the relevant sheet
        Set ws = ThisWorkbook.Sheets("Sheet1")
    
        With ws
            '~~> Get the Last Row
            lRow = .Range("L" & .Rows.Count).End(xlUp).Row
    
            '~~> Set your range for autofilter
            Set rRange = .Range("A5:L" & lRow)
    
            '~~> Remove any filters
            .AutoFilterMode = False
    
            '~~> Filter, copy visible rows to temp sheet
            With rRange
                .AutoFilter Field:=12, Criteria1:="Example"
    
                '~~> This is required to get the visible range
                ws.Rows("1:4").EntireRow.Hidden = True
    
                Set rngToCopy = .SpecialCells(xlCellTypeVisible).EntireRow
    
                Set wsTemp = Sheets.Add
    
                rngToCopy.Copy wsTemp.Range("A1")
    
                '~~> Unhide the rows
                ws.Rows("1:4").EntireRow.Hidden = False
            End With
    
            '~~> Remove any filters
            .AutoFilterMode = False
        End With
    
        '~~> Re arrange columns in Temp sheet so that we get C, I, H and F
        With wsTemp
            .Range("A:B,D:E,G:G,J:L").Delete Shift:=xlToLeft
            .Columns("D:D").Cut
            .Columns("B:B").Insert Shift:=xlToRight
            .Columns("D:D").Cut
            .Columns("C:C").Insert Shift:=xlToRight
    
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
            Set rngToCopy = .Range("A1:D" & lRow)
    
            Debug.Print rngToCopy.Address
    
            '~~> Copy the range to clipboard
            rngToCopy.Copy
        End With
    
        'NOTE
        '
        '~~> Once you have copied the range to clipboard, do the necessary
        '~~> actions and then delete the temp sheet. Do not delete the
        '~~> sheet before that. An alternative would be to use the APIs
        '~~> to place the range in the clipboard so you can safely delete
        '~~> the sheet before performing any actions. This will not clear
        '~~> clear the range if the sheet is immediately deleted.
        '
        '
    
        Application.DisplayAlerts = False
        wsTemp.Delete
        Application.DisplayAlerts = True
    End Sub

    SCHERMATA

    Foglio1 prima viene eseguito il codice

    VBA Filtro Tavolo e Copia Sottoinsieme di Colonne per Appunti

    Temp foglio con i dati filtrati

    VBA Filtro Tavolo e Copia Sottoinsieme di Colonne per Appunti

    Di FOLLOW-up

    Per rimuovere i bordi è possibile aggiungere il codice per il codice di cui sopra

    With rngToCopy
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    end with

    Mettere il codice di cui sopra dopo la riga Debug.Print rngToCopy.Address

    • Questo funziona bene, grazie! Ho bisogno di modificare il codice per togliere la formattazione (confine dalla tabella), ma dovrei essere in grado di capire. Sarebbe un cambio rapido per non copiare la riga di intestazione temporanea foglio di lavoro?
    • Cambiare questo rngToCopy.Copy wsTemp.Range("A1") per rngToCopy.Copy e nella riga successiva mettere questo wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    • Ignorare che l’ultimo commento, ho capito come modificare il codice per farlo. Grazie ancora per l’aiuto!!!
    • Ancora meglio. Grazie!
    • Beh, che la linea diventa il date in numeri interi.
    • Vuoi semplicemente rimuovere i bordi o qualsiasi altra formattazione?
    • Appena i bordi. Tutto il resto va bene.
    • Aggiornato il post sopra 🙂

  2. 0

    Si dovrà copiare le colonne individualmente, come oggetti che si riferiscono a intervalli richiedono le cellule per essere in ordine.

    Qualcosa come questo dovrebbe funzionare:

    activeworkbook.Sheets(1).Columns("C:C").copy activeworkbook.Sheets(2).Columns("A:A")
    activeworkbook.Sheets(1).Columns("I:I").copy activeworkbook.Sheets(2).Columns("B:B")
    activeworkbook.Sheets(1).Columns("H:H").copy activeworkbook.Sheets(2).Columns("C:C")
    activeworkbook.Sheets(1).Columns("F:F").copy activeworkbook.Sheets(2).Columns("D:D")

    allora si dovrebbe essere in grado di fare:

    activeworkbook.Sheets(2).Columns("A:D").copy 

    per ottenere il contenuto negli appunti

    • Non dovrebbe essere il contrario? Voglio dire, Copia C ~~> Un e, analogamente, per il resto? Anche si dispone di un errore di battitura nella seconda riga “B:”?
    • Ops, sì, dovrebbe essere il contrario (corretto errore di battitura di troppo)
    • Grazie per la risposta. Proverò questo metodo, così come è un po ‘ più semplice.

Lascia un commento