Domanda Macro per creare nuovo foglio incollando celle filtrate

mark84

Utente junior
29 Ottobre 2019
22
3
2016
1
Buongiorno,
chiedo il vostro supporto per creare, attraverso una macro, un nuovo foglio di lavoro in cui vengano incollate le celle filtrate di due fogli di lavoro, inserendole una sotto l'altra.
Nello specifico, nel foglio Output voglio che vengano incollate a valori le celle della colonna W del foglio List AS IS, filtrate per il valore "Rimuovere".
Sempre nel foglio Output, voglio che subito sotto alle celle appena incollate, vengano incollate a valori le celle della colonna D del foglio Nuovo Lst, filtrate per il valore "variare".
Ho già provato a registrare una macro ma ho l'impressione che i valori filtrati da incollare prendano dei riferimenti assoluti. Io invece ho bisogno che, anche inserendo dati diversi, vengano sempre copiati e incollati tutti i valori filtrati, quindi che i riferimenti sia relativi e non assoluti.
Allego il file e incollo la macro.
Spero possiate aiutarmi.
Grazie mille!
Mark

Visual Basic:
Sub clienti_marginali()
'
' clienti_marginali Macro
'
' Scelta rapida da tastiera: CTRL+w
'
    Sheets("List AS IS").Select
    Range("W1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AM$736").AutoFilter Field:=23, Criteria1:="<>"
    Sheets("Nuovo lst").Select
    Range("D1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$T$748").AutoFilter Field:=4, Criteria1:="<>"
    Windows("estrapolazione dati da caricare Gen21 (150025) - C.xlsm").Activate
    Sheets("List AS IS").Select
    Range("X21").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Output").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A24").Select
    Selection.End(xlDown).Select
    Range("A1187").Select
    Windows("estrapolazione dati da caricare Gen21 (150025) - C.xlsm").Activate
    Sheets("Nuovo lst").Select
    Range("E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Output").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1153").Select
    ActiveWindow.SmallScroll Down:=-12
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Desktop\Gen2021\Cartel1.csv", FileFormat:=xlCSV, _
        CreateBackup:=False
       
End Sub
 

Allegati

Ultima modifica di un moderatore:
  • Like
Reactions: kris9951

alfrimpa

VBA Expert
Supermoderatore
18 Dicembre 2015
34.993
2.445
67
Napoli
2019 Pro Plus
1.046
Hai postato la tua richiesta alle 14,26 e alle 16,45 già la solleciti?

Il sollecitare risposte è vietato dal regolamento perchè nessuno ha l'obbligo di rispondere.

Inoltre il codice nei post va inserito tra i TAG CODE; per come fare consulta gli avvisi dello staff (stavolta lo faccio io)
 

mark84

Utente junior
29 Ottobre 2019
22
3
2016
1
ho provato ad usare il comando

Range("X:AM" & Rows.Count).End(xlUp).Select
Selection.Copy

ma non funziona.

Avete qualche suggerimento?

Al di là del mio file, vorrei solo sapere quale stringa di codice inserire per selezionare tutte le celle filtrate in una colonna e copiarle su un altro file.
Grazie
 

alfrimpa

VBA Expert
Supermoderatore
18 Dicembre 2015
34.993
2.445
67
Napoli
2019 Pro Plus
1.046
Rammento gli artt. 13 e 17 del regolamento

Regola nr. 13 Nessun obbligo di risposta
Nessuno - né utenti, né moderatori - è in alcun modo obbligato a rispondere ai messaggi, né tantomeno a farlo entro stringenti limiti temporali arbitrariamente imposti da terzi. Nessuna motivazione di "urgenza" verrà minimamente tenuta in considerazione, se non in negativo.

Regola nr. 17 "Evitare UP"
In questo forum è vietato l'utilizzo del testo UP (o di un qualsiasi messaggio di sollecito) per mettere in rilievo la propria domanda, il forum ha i suoi tempi e ovviamente non c'è nessun obbligo da parte di nessuno a rispondere. Ogni abuso verrà tenuto in considerazione in futuro.
 

mark84

Utente junior
29 Ottobre 2019
22
3
2016
1
ok, solo che mi avevi chiesto di postare il file con il risultato che volevo ottenere, pensavo me l'avessi chiesto per poi rispondermi.
Ti chiedo questa cortesia perchè mi servirebbe per un progetto di lavoro abbastanza importante.
Grazie di nuovo
 

pigix

Utente abituale
15 Maggio 2020
279
30
365 WIN
35
ciao,

guardati il codice seguente

Visual Basic:
    Worksheets("Foglio1").Range("A2:B20").SpecialCells(xlCellTypeVisible).Copy Worksheets("Foglio2").Range("A1")
da provare su una cartella con due fogli e dati filtrati nel foglio1
 

mark84

Utente junior
29 Ottobre 2019
22
3
2016
1
Grazie della risposta.
Ho provato con questo codice ma sul nuovo foglio non mi riporta i valori filtrati ma tutte le celle dell'intervallo A2:B20.
Io ho bisogno che vengano riportate quelle filtrate e che il filtro sia dinamico e non ancorato a valori fissi, poiché i dati non sono sempre gli stessi e le celle filtrate non avranno sempre la stessa posizione assoluta.
 

kris9951

Utente abituale
12 Marzo 2019
481
30
Italy
2016
23
Ciao M @mark84 ,

prova questa soluzione PollicioneInSu
Fai sapere (se vuoi)

Visual Basic:
Sub Output()
    Dim wsLst As Worksheet
    Dim wsAS As Worksheet
    Dim wsOutput As Worksheet
    Dim matrice2() As Variant
    
    Set wsLst = Sheets("Nuovo lst")
    Set wsAS = Sheets("List AS IS")
    Set wsOutput = Sheets("Output")
    
    Call Modulo2.creaMatrici(matrice2(), wsLst, wsAS)
    
    Application.ScreenUpdating = False
    With wsOutput
        .Cells.ClearContents
        .Range("A1:P1").Value = wsLst.Range("E1:T1").Value
        .Cells(2, 1).Resize(UBound(matrice2), UBound(matrice2, 2)).Value = matrice2
        .Select
    End With
    Application.ScreenUpdating = True
    MsgBox "Output generato", vbInformation, "Operazione effettuata"
    Set wsLst = Nothing
    Set wsAS = Nothing
    Set wsAS = Nothing
    Erase matrice2
    
End Sub

Sub creaMatrici(matrice2() As Variant, ws1 As Worksheet, ws2 As Worksheet)
    Dim matrice1() As Variant
    Dim uriga As Long, x As Long, k As Long, j As Long
    uriga = ws1.Cells(1, 1).CurrentRegion.Rows.Count
    
    matrice1() = ws1.Range("D2:T" & uriga).Value
    
    For x = LBound(matrice1) To UBound(matrice1)
        If matrice1(x, 1) = "variare" Then
            k = k + 1
            ReDim Preserve matrice2(1 To 16, 1 To k)
            For j = 1 To 16
                matrice2(j, k) = matrice1(x, j + 1)
            Next j
        End If
    Next x
    
    Erase matrice1
    
    uriga = ws2.Cells(1, 1).CurrentRegion.Rows.Count
    matrice1() = ws2.Range("W2:AM" & uriga).Value
    
    For x = LBound(matrice1) To UBound(matrice1)
        If matrice1(x, 1) = "Rimuovere" Then
            k = k + 1
            ReDim Preserve matrice2(1 To 16, 1 To k)
            For j = 1 To 16
                matrice2(j, k) = matrice1(x, j + 1)
            Next j
        End If
    Next x
    
    Erase matrice1
    matrice2 = Application.WorksheetFunction.Transpose(matrice2)
End Sub
 

Allegati

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!