H o l a :
Pon la siguiente macro en tu libro "Solicitud Grupos AD"
Sub CopiarRegistrosFaltantes()
'Por.Dante Amor
'
Application.ScreenUpdating = False
'Determinar hoja de faltantes
nmax = 0
nhoja = "Registros Faltantes"
existe = False
For Each h In Sheets
If InStr(1, h.Name, nhoja) > 0 Then
num = Val(Mid(h.Name, Len(nhoja) + 2))
If num > nmax Then
nmax = num
End If
existe = True
End If
Next
If existe Then
Set h2 = Sheets(nhoja & " " & nmax)
Else
nmax = 1
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
h2.Name = nhoja & " " & nmax
End If
'
'copiar registros a la hoja faltantes
For Each h In Sheets
If InStr(1, h.Name, nhoja) = 0 Then
u = h.Range("A" & Rows.Count).End(xlUp).Row
h.Range("A1:F" & u).AutoFilter Field:=1, Criteria1:="<>"
h.Range("A1:F" & u).AutoFilter Field:=2, Criteria1:="<>"
h.Range("A1:F" & u).AutoFilter Field:=5, Criteria1:="<>"
h.Range("A1:F" & u).AutoFilter Field:=6, Criteria1:="="
u = h.Range("A" & Rows.Count).End(xlUp).Row
If u > 1 Then
cuenta = Application.CountA(h.Range("A2:A" & u).SpecialCells(xlCellTypeVisible))
tot_filas = h.Range("A" & Rows.Count).Row
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
disponible = tot_filas - u2
If cuenta > disponible Then
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
h2.Name = nhoja & " " & nmax + 1
End If
h.Rows("2:" & u).Copy
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Range("A" & u2).PasteSpecial Paste:=xlValues
End If
End If
Next
MsgBox "Agregar registros a hoja Faltantes", vbInformation, "Proceso Terminado"
End Sub
'_
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
‘_