estrarre per data

ciao a tutti

ho la necessita di estrarre dati da un foglio e incollarli su un altro foglio selezionando un intervallo di date

ho trovato questo codice che potrebbe essere l'ideale ma come il solito ho bisogno che funzioni senza visualizzare i fogli con i dati 
perché attiverò il codice con un pulsante da un userform e userò i dati estratti x caricare un listbox presente nello stesso userform

Sheets("Foglio1").Select
   Set rng = ActiveSheet.Range("D1:D1200")
   riga = 1
   contatore = 0
   
   cdata1 = Application.InputBox("Inserisci la 1° data", "Ricerca per data", Format(Date, "dd/mm/yyyy"))
   If Not cdata1 = False Then
      If IsDate(cdata1) Then
         cdata1 = Format(cdata1, "yyyy/mm/dd")
         cdata2 = Application.InputBox("Inserisci la 2° data", "Ricerca per data", Format(Date, "dd/mm/yyyy"))
         If Not cdata2 = False Then
            If IsDate(cdata2) Then
               cdata2 = Format(cdata2, "yyyy/mm/dd")
               If cdata1 <= cdata2 Then
                  Sheets("Record2").Cells.Clear
                  For Each cell In rng.Cells
                     If cell.Value = "" Then
                        Exit For
                     Else
                        If Format(cell.Value, "yyyy/mm/dd") >= cdata1 And Format(cell.Value, "yyyy/mm/dd") <= cdata2 Then
                           Rows(cell.Row).Select
                           Selection.Copy Destination:=Sheets("Foglio2").Cells(riga, 1)
                           riga = riga + 1
                           contatore = contatore + 1
                        End If
                     End If
                  Next
               End If
            Else
               MsgBox "Data errata"
            End If
         End If
      Else
         MsgBox "Data errata"
      End If
   End If
   [A1].Select
   MsgBox contatore & " righe copiate"

grazie  1000 in anticipo perché siete sempre iperattivi
ermanno
 

Informazioni domanda


Ultimo aggiornamento aprile 7, 2018 Visualizzazioni 817 Si applica a:
Risposta
ciao anche a te mauro
si forse hai ragione ho fatto un po di confusione
riformulo la domanda:  estrarre per data
ho bisogno di un codice che carica un listbox di un intervallo di dati compreso fra due date,

<cut>

non e necessario che sia questo il codice se cè un'altra strada più semplice da indicarmi va bene

spero di non aver fatto la mia solita confusione

ermanno


Se(se) quello che vuoi fare è estrarre da una tabella solo i dati che corrispondono ad un Range di dati e mettere il risultato in una Listbox che si trova sulla UserForm, questo codice presuppone che tu abbia la tua tabella a partire da A1 in Foglio1 e che voglia filtrare per la colonna C. Codivce da copia/incollare nel modulo di codice della UserForm:

 

 

Private Sub UserForm_Initialize()
    Call m
End Sub

 

Public Sub m()

On Error GoTo RigaErrore

    Dim sh As Worksheet
    Dim v1 As Variant
    Dim v2 As Variant
    Dim d1 As Date
    Dim d2 As Date
    Dim rng As Range
   
    v1 = Application.InputBox("Inserire la data inferiore nel formato: gg/mm/yyyy.", "Attenzione")
    v2 = Application.InputBox("Inserire la data superiore nel formato: gg/mm/yyyy.", "Attenzione")

 

    Application.ScreenUpdating = False
   
    If Len(v1) = 10 Or Len(v2) = 10 Then
        d1 = CDate(v1)
        d2 = CDate(v2)
        'MsgBox d1 & vbNewLine & d2
        Set sh = ThisWorkbook.Worksheets("Foglio1")
        With sh
            .Range("A1").AutoFilter _
                Field:=3, _
                Criteria1:=">=" & Format(d1, "mm/dd/yyyy"), _
                Operator:=xlAnd, _
                Criteria2:="<=" & Format(d2, "mm/dd/yyyy")
        End With
    Else
        If v1 <> False Then
            If v1 = "" Then
                MsgBox "Nessuna data inserita."
                Exit Sub
            Else
                Error 13
            End If
        End If
        If v2 <> False Then
            If v2 = "" Then
                MsgBox "Nessuna data inserita."
                Exit Sub
            Else
                Error 13
            End If
        End If
    End If
   
   
    Set rng = sh.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    rng.Copy
    ThisWorkbook.Worksheets.Add
    ActiveSheet.Range("A1").PasteSpecial
    Set rng = ActiveSheet.Range("A1").CurrentRegion
    Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
    Me.ListBox1.ColumnCount = rng.Columns.Count
    Me.ListBox1.List = rng.Value
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Application.CutCopyMode = False

RigaChiusura:
    Set rng = Nothing
    Set sh = Nothing

    Application.ScreenUpdating = True
    Exit Sub
   
RigaErrore:
    If Err.Number = 9 Then
        MsgBox Err.Number & vbNewLine & Err.Description
    Else
        MsgBox "Inserire la data nel formato valido."
    End If
    Resume RigaChiusura
   
End Sub

 

NOTA IMPORTANTE

Ho adattato codice di una soluzione differente, quindi la correzione degli errori è solo parziale e va implementata. Devi poi adattare al tuo contesto. Il file che ho utilizzato per l'esempio lo trovi qui:

http://www.maurogsc.eu/esempiforum13/listboxdate.zip

 

Se poi devi copiare i dati dalla Listbox ad un nuovo foglio, vedi qui:

http://answers.microsoft.com/it-it/office/wiki/office_2013_release-excel/excel-gestire-una-tabella-nascosta-tramite-una/3b6f6828-45c2-4319-98a6-148ae5488b71

Dai un'occhiata al codice del pulsante: Copia nel foglio

 

Tutto questo, se ho capito.

--
Mauro Gamberini
Microsoft© MVP (Excel)
http://www.maurogsc.eu

Il problema è stato risolto?

Siamo spiacenti che questo non sia stato d'aiuto.

Fantastico! Grazie per aver scelto questa risposta.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento, ci aiuta a migliorare il sito.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento.