Macro: Copiar y pegar de una hoja a otra

hola Manuel,

al final mas que un hilo parece una ristra.

al final te paso un codigo para que lo pruebes, pero te hago un par de
comentarios.

1º pega el codigo en un mcdulo NORMAL (menu insertar-> Modulo (a
secas) -> y en la pagina que se abre lo pegas (NO en el modulo de
Thisworkbook NI de las hojas)

2º aunque supongo que es un despiste de transcripcion, algunos de los
nuevos criterios que expones son un 'poquito' imposibles de
conseguir ,pej: and(e2!6100,e2&1400) convendras conmigo en que
resulta dificil que sea igual a 216100 y a la vez lo sea a 261400. Si
lo que quieress son filtrar los iguales quitales el and y los
parentesis, si buscas el intervalo añadeles el '<' y el '>' (en el
codigo que te paso es esto lo que he hecho)

bueno, prueba a ver esta modificacion. A mi me acaba de funcionar
perfectamenteen el archivo que me mandaste

Sub FiltrarPorRefYCantidad_3()
Dim hj As Worksheet, BD As Worksheet, Criterio As String, ultF As
Long, _
ultF_BD As Long, rngDestino As String, Criterio1 As String
Set BD = ThisWorkbook.Worksheets("lanorf")
With BD
If .AutoFilterMode Then .AutoFilterMode = False
On Error Resume Next
.ShowAllData
On Error GoTo 0
ultF_BD = .[c65536].End(xlUp).Row
Criterio1 = "and(e2>!3100,e2<!3900)," & _
"and(e2>!5000,e2<!6100),e2$2100,e2&1200," & _
"e2&1300,e2(4200,and(e2>61100,e2<61200)," & _
"e262200,and(e2>I0000,e2<I9000)"
For Each hj In ThisWorkbook.Worksheets
If hj.Name <> "lanorf" And Application.CountIf(.[c:c], hj.Name)

0 Then

''' si te diera problemas con esta parte, desmarca el siguiente
'If' y
''' ponle una comilla simple al anterior o eliminalo
' If hj.Name <> "lanorf" Then
.[a1:t1].Copy hj.[a1]: ultF = hj.[c65536].End(xlUp).Row + 1
rngDestino = "a" & ultF & ":t" & ultF
Select Case hj.Name
Case "A-320"
Criterio = Criterio1 & ",and(e2>$2100,e2<$2199)," & _
"e2&1200,e261100"
Case "M-XX", "M-X1"
Criterio = Criterio1 & ",and(e2>!6100,e2<&1400)"
Case "B-XXX"
Criterio = Criterio1 & ",and(e2>$1100,e2<$1110)"
Case Else
Criterio = Criterio1
End Select
Criterio = "=and(c2=""" & hj.Name & """,or(" & Criterio & "))"
.[v1:v2].ClearContents: .[v2].Formula = Criterio
.Range("a1:t" & ultF_BD).AdvancedFilter _
Action:=xlFilterCopy, criteriarange:=.[v1:v2], _
copytorange:=hj.Range(rngDestino), unique:=False
With hj: .Rows(ultF).Delete: .Columns.AutoFit: End With
End If
Next
.[v2].Clear
End With
Set BD = Nothing
End Sub

bueno a ver si hay suerte

un saludo
ivan

PD: revisa los criterios ('despacito')

PPD: en unos dis te devuelvo tu archivo (ando liado)

hola de nuevo, Manuel

como siempre me repito:

aunque no dejes de leer lo comentado en el mensaje anterior, si
quieres prueba mejor este codigo, pues aparte de aclarar bastante el
codigo, te permite manipular los criterios/constantes con mucha mas
comodidad, aprte de velas mejor


pega TODO esto en un modulo NORMAL NUEVO sobre lo que haya (borralo o
sobreescribelo, para que solo te quede esto en el modulo) (ojo a los
saltos delinea y revisa/ajusta los criterios)

'' pega desde aqui
Option Explicit
'' constantes con los criterios para que puedas manipularlos
'' con mas facilidad y aclarar el codigo
'
Public Const Criterios_Comunes As String = _
"and(e2>!3100,e2<!3900)," & _
"and(e2>!5000,e2<!6100)," & _
"e2$2100," & _
"e2&1200," & _
"e2&1300," & _
"e2(4200," & _
"and(e2>61100,e2<61200)," & _
"e262200," & _
"and(e2>I0000,e2<I9000)"
Public Const Criterios_A320 As String = _
",and(e2>$2100,e2<$2199)" & _
",e2&1200," & _
"e261100"
Public Const Criterios_M87_M88 As String = _
",and(e2>!6100,e2<&1400)"
Public Const Criterios_B757 As String = _
",and(e2>$1100,e2<$1110)"
'
'' procedimiento
'
Sub FiltrarPorRefYCantidad_4()
Dim Criterio1 As String, Criterio As String, _
ultF_BD As Long, ultF As Long, hj As Worksheet
With ThisWorkbook.Worksheets("lanorf")
If .AutoFilterMode Then .AutoFilterMode = False
ultF_BD = .[c65536].End(xlUp).Row
For Each hj In ThisWorkbook.Worksheets
If hj.Name <> "lanorf" And _
Application.CountIf(.[c:c], hj.Name) > 0 Then
.[a1:t1].Copy hj.[a1]
ultF = hj.[c65536].End(xlUp).Row + 1
Select Case hj.Name
Case "A-320": Criterio = Criterios_Comunes & Criterios_A320
Case "M-87", "M-88"
Criterio = Criterios_Comunes & Criterios_M87_M88
Case "B-757": Criterio = Criterios_Comunes & Criterios_B757
Case Else: Criterio = Criterios_Comunes
End Select
Criterio = "=and(c2=""" & hj.Name & """,or(" & Criterio & "))"
.[v1:v2].ClearContents: .[v2].Formula = Criterio
.Range("a1:t" & ultF_BD).AdvancedFilter _
Action:=xlFilterCopy, _
criteriarange:=.[v1:v2], _
copytorange:=hj.Range("a" & ultF & ":t" & ultF), _
unique:=False
With hj: .Rows(ultF).Delete: .Columns.AutoFit: End With
End If
Next
.[v2].Clear
End With
End Sub
'' hasta aqui

a ver que tal

un saaaludo
ivan