serve una Macro per fare filtro su una colona e poi copiare il risultato su una nuova pagina

Anonimo

Devo creare una macro che mi faccia filtrare nella colona M del mio primo foglio (Ordini da Produrre) tutti i dati con data. Poi copiare tutti i dati filtrati e fare paste sul secondo foglio ( (tab graf.) il range da copiare e dalla colono B fino alla colona Q dei dati filtrati.

Grazie.

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Kimi_266,

In attesa della tua risposta, per copiare solo i record che hanno una data qualsiasi nella colonna Note, prova il seguente codice aggiornato:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim srcSH As Worksheet, destSH As Worksheet 

Dim srcRng As Range, destRng As Range, copyRng As Range

Dim arrIn As Variant 

Dim iRow As Long, jRow As Long, iCtr As Long 

Const sFoglio\_Sorgente As String = **"Ordini da Produrre "          '&lt;&lt;=== Modifica** 

Const sFoglio\_Destinazione As String = **"Tab graf."                      '&lt;&lt;=== Modifica** 

Const sColonne\_Da\_Copiare As String = **"B:Q"                              '&lt;&lt;=== Modifica** 

Const sColonne\_Da\_Incollare As String = **"A:O"                             '&lt;&lt;=== Modifica** 

Const sColonna\_Data As String = **"L"                                             '&lt;&lt;=== Modifica** 

Const iPrima\_Riga\_Dati As Long = **2                                               '&lt;&lt;=== Modifica** 

Const sPrimaColonna\_Destinazione As String = **"A"                      '&lt;&lt;=== Modifica** 

Const sColonna\_Da\_Non\_Copiare As String = **"I"                           '&lt;&lt;=== Modifica** 

Set WB = ThisWorkbook 

With WB 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

With srcSH 

    iRow = LastRow(srcSH, .Columns(sColonne\_Da\_Copiare), iPrima\_Riga\_Dati) 

    Set srcRng = .Range(sColonne\_Da\_Copiare).Resize(iRow - iPrima\_Riga\_Dati + 1).Offset(iPrima\_Riga\_Dati - 1) 

    srcSH.Columns(sColonna\_Da\_Non\_Copiare).Hidden = True 

End With 

srcRng.AutoFilter Field:=13, Operator:= \_ 

    xlFilterValues, Criteria2:=Array(0, "12/31/2024", 0, "12/31/2023", 0, "12/31/2022") 

On Error Resume Next 

Set copyRng = srcRng.SpecialCells(xlCellTypeVisible) 

On Error GoTo XIT 

If copyRng Is Nothing Then 

    Call MsgBox(Prompt:="Nessun dato trovato da copiare!", \_ 

        Buttons:=vbInformation, \_ 

        Title:="REPORT") 

    GoTo XIT 

End If 

With destSH 

    jRow = LastRow(srcSH, .Columns(sColonne\_Da\_Incollare)) 

    Set destRng = .Cells(jRow + 1, sPrimaColonna\_Destinazione) 

End With 

copyRng.Copy Destination:=destRng

XIT:

With srcSH 

    .ShowAllData 

    .Columns(sColonna\_Da\_Non\_Copiare).Hidden = False 

End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, \_ 

Optional minRow As Long = 1) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastRow = Rng.Find(What:="\*", \_ 

    After:=Rng.Cells(1), \_ 

    Lookat:=xlPart, \_ 

    LookIn:=xlFormulas, \_ 

    SearchOrder:=xlByRows, \_ 

    SearchDirection:=xlPrevious, \_ 

    MatchCase:=False).Row 

On Error GoTo 0 

If LastRow &lt; minRow Then 

    LastRow = minRow 

End If

End Function

'<<========

Potresti scaricare il mio file di prova Kimi20221201.xlsm

===

Regards,

Norman

0 commenti

9 risposte aggiuntive

Anonimo

2022-11-30T13:42:41+00:00

Non riesco a cambiare anche se o copiato il file https://1drv.ms/x/s!AkdD5k9Wm-V-hGwlUMrDF8kM8bES?e=VgyoR2
La risposta è stata utile?

0 commenti Nessun commento

Anonimo

Ciao Kimi_266,

no i dati copiati devono essere aggiunti nel foglio -Tab graf. Il foglio e senza dati ha solo la testata e nella colona P sono delle celle con formula.

Prova qualcosa del genere:

Alt+F11 per aprire l'editor di VBA
Alt+IM per inserire un nuovo modulo di codice
Nel nuovo modulo vuoto, incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim WB As Workbook 

Dim srcSH As Worksheet, destSH As Worksheet 

Dim srcRng As Range, destRng As Range, copyRng As Range, rRow As Range 

Dim arrIn As Variant 

Dim iRow As Long, jRow As Long, iCtr As Long 

Const sFoglio\_Sorgente As String = **"Ordini da Produrre"           '&lt;&lt;=== Modifica** 

Const sFoglio\_Destinazione As String = **"tab graf"                       '&lt;&lt;=== Modifica** 

Const sColonns\_Da\_Copiare As String = **"B:Q"                              '&lt;&lt;=== Modifica** 

Const sColonne\_Da\_Incollare As String = **"A:O"                            '&lt;&lt;=== Modifica**    

Const sColonna\_Data As String = **"L"                                             '&lt;&lt;=== Modifica** 

Const iPrima\_Riga\_Dati As Long = **2                                               '&lt;&lt;=== Modifica** 

Const sPrimaColonna\_Destinazione As String = **"A"                      '&lt;&lt;=== Modifica** 

Const sColonna\_Da\_Non\_Copiare As String = **"I"                          '&lt;&lt;=== Modifica** 

Set WB = ThisWorkbook 

With WB 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

With srcSH 

    iRow = LastRow(srcSH, .Columns(sColonne\_Da\_Copiare), iPrima\_Riga\_Dati) 

    Set srcRng = .Range(sColonne\_Da\_Copiare).Resize(iRow - iPrima\_Riga\_Dati + 1).Offset(iPrima\_Riga\_Dati - 1) 

End With 

For Each rRow In srcRng.Rows 

    rRow.EntireRow.Hidden = Not IsDate(Intersect(rRow, srcSH.Columns(sColonna\_Data))) 

Next rRow 

srcSH.Columns(sColonna\_Da\_Non\_Copiare).Hidden = True 

On Error Resume Next 

Set copyRng = srcRng.SpecialCells(xlCellTypeVisible) 

On Error GoTo 0 

If copyRng Is Nothing Then 

    Call MsgBox(Prompt:="Nessun dato trovato da copiare!", \_ 

        Buttons:=vbInformation, \_ 

        Title:="REPORT") 

    GoTo XIT 

End If 

With destSH 

    jRow = LastRow(srcSH, .Columns(sColonne\_Da\_Incollare)) 

    Set destRng = .Cells(jRow + 1, sPrimaColonna\_Destinazione) 

End With 

copyRng.Copy Destination:=destRng 

srcRng.EntireRow.Hidden = False

XIT:

   srcRng.EntireRow.Hidden = False 

    srcSH.Columns(sColonna\_Da\_Non\_Copiare).Hidden = True

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, \_ 

Optional minRow As Long = 1) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastRow = Rng.Find(What:="\*", \_ 

    After:=Rng.Cells(1), \_ 

    Lookat:=xlPart, \_ 

    LookIn:=xlFormulas, \_ 

    SearchOrder:=xlByRows, \_ 

    SearchDirection:=xlPrevious, \_ 

    MatchCase:=False).Row 

On Error GoTo 0 

If LastRow &lt; minRow Then 

    LastRow = minRow 

End If

End Function

'<<========

Alt+Q per chiudere l'editor di VBA e tornare a Excel.
Salva il file con l'estensione xlsm
Alt+F8 per aprire la finestra di gestione delle macro
Seleziona Tester
Esegui

Potresti scaricare il mio file di prova Kimi20221130.xlsm

A causa di un problema con l'attuale editor del forum, che inserisce righe vuote indesiderate nel codice copiato dal forum, suggerirei di copiare il mio codice direttamente dal mio file di prova.

===

Regards,

Norman

0 commenti

Anonimo

2022-11-30T09:37:47+00:00

no i dati copiati devono essere aggiunti nel foglio -Tab graf. Il foglio e senza dati ha solo la testata e nella colona P sono delle celle con formula.
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2022-11-30T08:58:45+00:00

Ciao Kimi_266,

Devo creare una macro che mi faccia filtrare nella colona M del mio primo foglio (Ordini da Produrre) tutti i dati con data. Poi copiare tutti i dati filtrati e fare paste sul secondo foglio ( (tab graf.) il range da copiare e dalla colono B fino alla colona Q dei dati filtrati.

I dati copiati devono sostituire i dati esistenti sul secondo foglio o devono essere aggiunti?

Sarebbe anche utile se dovessi caricare un file di esempio, senza dati sensibili.

Per caricare il file su Microsoft OneDrive, vedi:

Condividere file e cartelle di OneDrive

Per caricare il file su DropBox, vedi:

Come faccio a condividere file e cartelle in Dropbox?

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento

Condividi tramite

serve una Macro per fare filtro su una colona e poi copiare il risultato su una nuova pagina

9 risposte aggiuntive