Modificar rango de datos donde se copian datos filtrados

roa30 · el 9 de marzo

Hola a todos! les comparto un archivo en el que estoy trabajando , lo modifique en base a un archivo que encontre aqui en el foro.

Tengo en la Hoja 4 unos boton de check, que hasta ahora solo configure uno....

la idea que al seleccionar la primera opcion "Menos de $1.000" , me filtre los datos de la hoja 1, y me los pegue en la misma hoja 4 a partir del rango Hoja4 (G14:N)

El archivo de base que tome como ejemplo, me pega los datos correctamente en la hoja 3, pero cuando lo modifico para que me los ponga en la hoja 4 en el rango que tengo para agregar los datos, me los arroja en cualquier lado...

me podrian ayudar por favor

si mal no recuerdo el archivo lo habia tomado de una respuesta del genio de @JSDJSD a otro tema similar.!

desde ya agradezco un monton vtener la oportunidad de volver a este foro lleno de tantas personas que admiro por su talento y conocimiento

Saludos Romi

Sub B()
Application.ScreenUpdating = False
Hoja1.Activate
Hoja4.Range("G14:N1600").ClearContents
Hoja1.Range("C1").Select

While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
If ActiveCell = "B- Menos de $1.000" Then
ActiveCell.EntireRow.Copy

Hoja4.Activate
Hoja4.Range("G14").Select
While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Wend
ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
   
Hoja1.Activate
   Application.CutCopyMode = False
End If

Wend

Hoja4.Activate
End Sub

Pruebas.xlsmFetching info...

Antoni · el 9 de marzo

Abre el adjunto y pulsa sobre cualquiera de las opciones de la hoja Categoria.

Estas son las macros:

Sub FiltroB(): Filtro "B- Menos de $1.000":      End Sub
Sub FiltroC(): Filtro "C- De $1.000 a $5.000":   End Sub
Sub FiltroD(): Filtro "D- De $5.000 a $15.000":  End Sub
Sub FiltroE(): Filtro "E- De $15.000 a $25.000": End Sub
Sub FiltroF(): Filtro "F- De $25.000 a $50.000": End Sub
Sub FiltroG(): Filtro "G- Más de $50.000":       End Sub
'-------------------------------------------------------
Private Sub Filtro(Categoria As String)
Application.ScreenUpdating = False
Hoja4.Range("G14:N1600").ClearContents
fila = 13
For x = 2 To Hoja1.UsedRange.Rows.Count
   If Hoja1.Range("C" & x) = Categoria Then
      fila = fila + 1
      Hoja1.Range("A" & x).Resize(1, 9).Copy
      Hoja4.Range("G" & fila).PasteSpecial xlValues
   End If
Next
Application.CutCopyMode = False
Hoja4.Activate
End Sub

Pruebas (3).xlsmFetching info...