Macro busque encuentre y copie
Hola!
Espero me puedas ayudar
Estoy tratando de hacer que una macro localice distintos títulos que se encuentran en la columna C
Una vez localizado el primer título (grupo 1) copie de la celda inferior hasta que se tope con otro título (grupo 2)
Y así sucesivamente en todos los grupos (títulos) que le indique
Te muestro las macros que estoy haciendo, todas están juntas para que vaya localizando la info que necesito y la pegue en su correspondiente hoja de grupo
Macro 1
Sheets("Hoja1").Select
Cells.Find(What:="Aclaraciones_POS", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("C13:AB129").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Aclaraciones_POS").Select
ActiveSheet.Paste
Sheets("Hoja1").Select
Range("A1").Select
Cells.Find(What:="CAU_CAJEROS", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("C1282:AB1398").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CAU_CAJEROS").Select
ActiveSheet. Paste
El hecho es que los rangos lo estoy poniendo mano, y quisiera que fuera en automático ya que la información no siempre es la misma
Como te comente los títulos (pero de muchísimos grupos) vienen en la columna C y no hay nada más
Espero me puedas ayudar!
Espero me puedas ayudar
Estoy tratando de hacer que una macro localice distintos títulos que se encuentran en la columna C
Una vez localizado el primer título (grupo 1) copie de la celda inferior hasta que se tope con otro título (grupo 2)
Y así sucesivamente en todos los grupos (títulos) que le indique
Te muestro las macros que estoy haciendo, todas están juntas para que vaya localizando la info que necesito y la pegue en su correspondiente hoja de grupo
Macro 1
Sheets("Hoja1").Select
Cells.Find(What:="Aclaraciones_POS", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("C13:AB129").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Aclaraciones_POS").Select
ActiveSheet.Paste
Sheets("Hoja1").Select
Range("A1").Select
Cells.Find(What:="CAU_CAJEROS", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("C1282:AB1398").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CAU_CAJEROS").Select
ActiveSheet. Paste
El hecho es que los rangos lo estoy poniendo mano, y quisiera que fuera en automático ya que la información no siempre es la misma
Como te comente los títulos (pero de muchísimos grupos) vienen en la columna C y no hay nada más
Espero me puedas ayudar!
1 Respuesta
Respuesta de Enrique Bernal
1
Según lo que entiendo cada titulo tiene una hoja con su nombre y quieres copiar la info de la hoja 1 en cada hoja según su titulo, si los títulos no son siempre los mismos podrías utilizar la macro que te paso con la opción de incluir siempre los títulos, en caso contrario puedes quemar los títulos en cada variable como en el ultimo caso del ejemplo que te pongo. Al final
Sub Copia_Pega()
A = InputBox("Titulos", "Ingresar el 1er titulo de los grupos")
B = InputBox("Titulos", "Ingresar el 2do titulo de los grupos")
C = InputBox("Titulos", "Ingresar el 3er titulo de los grupos")
D = InputBox("Titulos", "Ingresar el 4to titulo de los grupos")
e = "mi quinto titulo"
Sheets("Hoja1").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
a1 = ActiveCell.Address
Cells.Find(What:=b, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
b1 = ActiveCell.Address
b2 = ActiveCell.Row - 1
Cells.Find(What:=c, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
c1 = ActiveCell.Address
c2 = ActiveCell.Row - 1
Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
d1 = ActiveCell.Address
d2 = ActiveCell.Row - 1
Cells.Find(What:=e, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
e1 = ActiveCell.Address
e2 = ActiveCell.Row - 1
'Esta ultima parte es la que copia en las diferentes hojas, te hice una tu debes hacer las que necesites
Range(a1 & ":" & "A" & b2).Select
Selection.Copy
Sheets(a).Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Hoja1").Select
End Sub
No olvides finalizar la pregunta
Sub Copia_Pega()
A = InputBox("Titulos", "Ingresar el 1er titulo de los grupos")
B = InputBox("Titulos", "Ingresar el 2do titulo de los grupos")
C = InputBox("Titulos", "Ingresar el 3er titulo de los grupos")
D = InputBox("Titulos", "Ingresar el 4to titulo de los grupos")
e = "mi quinto titulo"
Sheets("Hoja1").Select
Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
a1 = ActiveCell.Address
Cells.Find(What:=b, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
b1 = ActiveCell.Address
b2 = ActiveCell.Row - 1
Cells.Find(What:=c, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
c1 = ActiveCell.Address
c2 = ActiveCell.Row - 1
Cells.Find(What:=d, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
d1 = ActiveCell.Address
d2 = ActiveCell.Row - 1
Cells.Find(What:=e, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
e1 = ActiveCell.Address
e2 = ActiveCell.Row - 1
'Esta ultima parte es la que copia en las diferentes hojas, te hice una tu debes hacer las que necesites
Range(a1 & ":" & "A" & b2).Select
Selection.Copy
Sheets(a).Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Hoja1").Select
End Sub
No olvides finalizar la pregunta
