Ayuda para modificar macro

Saludos Dam, cree un userform(Reporte_de_Excedentes), donde tengo 1 Listbox, 2 DTPicker y un commandbutton.

La macro que me realizaste para pasar las jugadas excedentes del limite a la hoja(Reporte de excedente) la agrege al commandbutton. Este es el codigo

Private Sub valida_datos() 'Por.DAM Application.ScreenUpdating = False
Set h0 = Sheets("Jugados") Set h2 = Sheets("Reporte de Excedente") Set h3 = Sheets("Configuracion de las Jugadas")
'Se copia la hoja a una temporal para ordenar los datos h0.Select h0.Cells.Copy Sheets.Add ActiveSheet.Paste
Set h1 = ActiveSheet
 Columns("A:R").Select Selection.Sort Key1:=Range("N2"), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal
 Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, _ Key2:=Range("F2"), Order2:=xlAscending, _ Key3:=Range("G2"), Order3:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, _ DataOption2:=xlSortNormal, _ DataOption3:=xlSortNormal
 i = 2 d1_ant = h1.Cells(i, "J") 'Fecha d2_ant = h1.Cells(i, "F") 'Lotería d3_ant = h1.Cells(i, "G") 'Juego d4_ant = h1.Cells(i, "Q") 'Njugados subtot = 0 j = 2 h2.Cells.ClearContents h2.Range("A1:E1") = Array("Fecha Juego", "Loteria", "Juego", "Njugados", "Excedente") For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row + 1 If d1_ant = h1.Cells(i, "J") And _ d2_ant = h1.Cells(i, "F") And _ d3_ant = h1.Cells(i, "G") And _ d4_ant = h1.Cells(i, "Q") Then subtot = subtot + Val(h1.Cells(i, "A")) Else limite = Application.VLookup(Mid(d3_ant, 3), h3.Range("E1:F5"), 2, 0) If subtot > limite Then h2.Cells(j, "A") = d1_ant h2.Cells(j, "B") = d2_ant h2.Cells(j, "C") = d3_ant h2.Cells(j, "D") = "'" & d4_ant h2.Cells(j, "E") = subtot
 j = j + 1 End If subtot = Val(h1.Cells(i, "A")) End If d1_ant = h1.Cells(i, "J") 'Fecha d2_ant = h1.Cells(i, "F") 'Lotería d3_ant = h1.Cells(i, "G") 'Juego d4_ant = h1.Cells(i, "Q") 'Njugados Next Application.DisplayAlerts = False h1.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Proceso Terminado", vbInformation, "SUBTOTALES" End Sub

Lo que quiero es que solo pase a la hoja de "Reporte de excedentes" las jugadas que cumplan con la fechas entre DTPicker1 y el DTPicker2 y luego las demas validaciones que hace.

Añade tu respuesta

Haz clic para o