Copiar si A15:A1676 >82 filas completas en hoja 5
Hola, mi consulta es la siguiente: en el rango A15:A1676 tengo toda clase de valores, necesito una macro que si el valor de una o varias de esas celdas es mayor que 82 me copie la fila o las filas enteras correspondientes a esa o esas celdas en la hoja 5 de forma correlativa una debajo de la otra.
1 Respuesta
Respuesta de blooddragon
1
Este código te debe servir
Sub copia_valores()
On Error GoTo EH
Dim NHoja As String
Dim Val As Variant
Dim i, j As Integer
ActiveWorkbook.Sheets("Hoja1").Activate
ActiveSheet.Cells(1, 1).Activate
i = 1
While ActiveCell.Value <> ""
i = i + 1
If ActiveCell.Value > 85 Then
ActiveCell.Select
Selection.Copy
Sheets("Hoja5").Select
j = ActiveCell.Row
While ActiveCell.Value <> ""
j = j + 1
ActiveSheet.Cells(j, 1). Activate
Wend 'While ActiveCell <> ""
ActiveSheet.Paste
ActiveWorkbook.Sheets("Hoja1").Activate
End If 'If ActiveCell.Validation > 85 Then
ActiveSheet.Cells(i, 1).Activate
Wend 'While ActiveCell.Value <> ""
Exit Sub
EH:
Select Case Err.Number
Case 1004:
Resume Next
Case Else:
MsgBox Err.Number & "-" & Err.Description
End Select
End Sub
Sub copia_valores()
On Error GoTo EH
Dim NHoja As String
Dim Val As Variant
Dim i, j As Integer
ActiveWorkbook.Sheets("Hoja1").Activate
ActiveSheet.Cells(1, 1).Activate
i = 1
While ActiveCell.Value <> ""
i = i + 1
If ActiveCell.Value > 85 Then
ActiveCell.Select
Selection.Copy
Sheets("Hoja5").Select
j = ActiveCell.Row
While ActiveCell.Value <> ""
j = j + 1
ActiveSheet.Cells(j, 1). Activate
Wend 'While ActiveCell <> ""
ActiveSheet.Paste
ActiveWorkbook.Sheets("Hoja1").Activate
End If 'If ActiveCell.Validation > 85 Then
ActiveSheet.Cells(i, 1).Activate
Wend 'While ActiveCell.Value <> ""
Exit Sub
EH:
Select Case Err.Number
Case 1004:
Resume Next
Case Else:
MsgBox Err.Number & "-" & Err.Description
End Select
End Sub
