He estado trabajando en una macro para extraer la información de 2 hojas de un libro y que la información quede en un nuevo libro y que se guarde en una carpeta. Tengo un libro donde está todo el de RIESGOS VERSION FINAL está la información que necesitamos, hay 2 hojas ahí con la que trabajaremos, SOD y Resumen X usuario, en la hoja SOD filtramos por empresa, (es importante filtrar por empresa ya que se guardará en una carpeta con el nombre de esa empresa el archivo generado) y ahí tomamos un cargo, copiamos las columnas A (CARGO), D (ID RISK), E (DES RIESGO), F (NIVEL), G (ID FUN), H (DES FUN), I (TRX), J (DES TRX) y esa info la pegamos desde la celda A2, luego copiamos el nombre del cargo en la otra hoja (Resumen x Usuario), se filtra por cargo el mismo cargo y validador de la hoja SOD copiamos los usuarios y el centro de los usuarios con ese cargo y lo pegamos en otro lado quitando luego los duplicados, copiamos el resultado y vamos a la hoja donde estamos guardando los datos del cargo, a continuación de la celda que dice la descripción de la trx presionamos botón derecho, pegado especial, seleccionamos pegado por valores y marcamos la casilla transponer, y aceptar, así se nos pegaran los valores hacia el lado, luego vemos el último usuario que se pegó con su centro y al lado de eso dejamos una celda para comentarios, en el nombre de la hoja ponemos el nombre del cargo y guardamos la planilla con el nombre del cargo en la carpeta de la empresa que filtramos al comienzo.
Adjunto una planilla ejemplo (Analista de respuesto) es el formato para entender lo que se necesita. y adjunto macro Libro1
He estado trabajando en una macro para extraer la información de 2 hojas de un libro y que la información quede en un nuevo libro y que se guarde en una carpeta. Tengo un libro donde está todo el de RIESGOS VERSION FINAL está la información que necesitamos, hay 2 hojas ahí con la que trabajaremos, SOD y Resumen X usuario, en la hoja SOD filtramos por empresa, (es importante filtrar por empresa ya que se guardará en una carpeta con el nombre de esa empresa el archivo generado) y ahí tomamos un cargo, copiamos las columnas A (CARGO), D (ID RISK), E (DES RIESGO), F (NIVEL), G (ID FUN), H (DES FUN), I (TRX), J (DES TRX) y esa info la pegamos desde la celda A2, luego copiamos el nombre del cargo en la otra hoja (Resumen x Usuario), se filtra por cargo el mismo cargo y validador de la hoja SOD copiamos los usuarios y el centro de los usuarios con ese cargo y lo pegamos en otro lado quitando luego los duplicados, copiamos el resultado y vamos a la hoja donde estamos guardando los datos del cargo, a continuación de la celda que dice la descripción de la trx presionamos botón derecho, pegado especial, seleccionamos pegado por valores y marcamos la casilla transponer, y aceptar, así se nos pegaran los valores hacia el lado, luego vemos el último usuario que se pegó con su centro y al lado de eso dejamos una celda para comentarios, en el nombre de la hoja ponemos el nombre del cargo y guardamos la planilla con el nombre del cargo en la carpeta de la empresa que filtramos al comienzo.
Adjunto una planilla ejemplo (Analista de respuesto) es el formato para entender lo que se necesita. y adjunto macro Libro1
Esto es lo que tengo en mi código:
Sub Macro1()
'
' Macro1 Macro
'
Dim x As Integer
Sheets("SOD-CARGO").Select
NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
Range("A2").Select
' For x = 1 To NumRows
Columns("A:A").Select
Selection.Copy
Sheets("CARGOS").Select
ActiveSheet.Paste
Application.CutCopyMode = False
NumRowsX = Range("A2", Range("A2").End(xlDown)).Rows.Count
ActiveSheet.Range("$A$1:$A$" & NumRowsX).RemoveDuplicates Columns:=1, Header:= _
xlYes
Range("A2").Select
Selection.Copy
Sheets("SOD-CARGO").Select
' Range("A8").Select
NumRowsY = Range("A2", Range("A2").End(xlDown)).Rows.Count
ActiveSheet.Range("$A$1:$J$" & NumRowsY).AutoFilter Field:=1, Criteria1:=Array( _
"Ingeniero Ventas Equipos"), _
Operator:=xlFilterValues
Range("A1:J" & NumRowsY).Select
Range("A8").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("SOD1").Select
Range("B1").Select
ActiveSheet.Paste
Range("B2").Select
Sheets("CARGOS").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("SOD1").Select
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],R1C1,1,0)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A141")
Range("A2:A141").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$K$141").AutoFilter Field:=1, Criteria1:= _
"Ingeniero Ventas Equipos"
NumRowsY = Range("A2", Range("A2").End(xlDown)).Rows.Count
Range("A1:K" & NumRowsY).Select
Selection.Copy
Sheets("SOD2").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
' Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '
Range("A3").Select
Selection.Copy
Sheets("DATOS-USER").Select
NumRowsZ = Range("A2", Range("A2").End(xlDown)).Rows.Count
ActiveSheet.Range("$A$1:$H$" & NumRowsZ).AutoFilter Field:=1, Criteria1:=Array( _
"Ingeniero Ventas Equipos"), _
Operator:=xlFilterValues
Range("A1:H" & NumRowsZ).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DATOS1").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Sheets("SOD2").Select
Selection.Copy
Sheets("DATOS1").Select
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],R1C1,1,0)"
Range("A2").Select
NumRowsA = Range("A2", Range("A2").End(xlDown)).Rows.Count
Selection.AutoFill Destination:=Range("A2:A" & NumRowsA)
Range("A2:A" & NumRowsA).Select
Range("B1").Select
NumRowsB = Range("A2", Range("A2").End(xlDown)).Rows.Count
Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$" & NumRowsB).AutoFilter Field:=1, Criteria1:= _
"Ingeniero Ventas Equipos"
Columns("D:E").Select
Selection.Copy
Sheets("DATOS2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
NumRowsC = Range("A2", Range("A2").End(xlDown)).Rows.Count
ActiveSheet.Range("$A$1:$B$" & NumRowsC).RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("I1").Select
Sheets("SOD2").Select
Range("I1").Select
ActiveSheet.Paste
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("K2").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("I3").Select
ActiveCell.FormulaR1C1 = "X"
uc = Range("A2").End(xlToRight).Column
ActiveSheet.Cells(3, uc).Value = "X"
NumRowsE = Range("A2", Range("A2").End(xlDown)).Rows.Count
ActiveSheet.Cells(NumRowsE, 9).Value = "X"
Range("I3").Select
ActiveWindow.SmallScroll Down:=-3
Selection.Copy
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
NumRowsD = Range("A2", Range("A2").End(xlDown)).Rows.Count
ActiveWindow.SmallScroll Down:=NumRowsD
Range("U67").Select
Selection.End(xlUp).Select
Range("S1").Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("A2").Select
Selection.End(xlDown).Select
Rows("63:63").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("L59").Select
Selection.End(xlUp).Select
Windows("Libro1.xlsm").Activate
uc_2 = Range("A2").End(xlToRight).Column
Range("A1:Y").Select
Range("L1").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=12
ActiveWindow.SmallScroll Down:=-3
Windows("Libro1.xlsm").Activate
ActiveWindow.SmallScroll Down:=-18
Cells.Select
Range("A37").Activate
Application.CutCopyMode = False
Selection.Copy
' Windows("prueba.xlsx").Activate '
Range("A1").Select
ActiveSheet.Paste
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Selection.End(xlToRight).Select
Range("Z2").Select
ActiveSheet.Paste
Range("Y2").Select
Selection.End(xlToLeft).Select
Range("Z2").Select
Application.CutCopyMode = False
uc_1 = Range("A2").End(xlToRight).Column
ActiveSheet.Cells(2, uc_1 + 1).Value = "COMENTARIOS"
' ActiveCell.FormulaR1C1 = "COMENTARIOS"
Cells.Select
Range("P1").Activate
Cells.EntireColumn.AutoFit
Range("P2").Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A3").Select
Selection.Copy
Application.CutCopyMode = False
Sheets("SOD2").Select
Cells.Select
Selection.Copy
Workbooks.Add.Worksheets(1).Paste
ChDir "C:\Users\vinim\Desktop\macro"
ActiveCell.FormulaR1C1 = "Ingeniero Ventas Equipos"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\vinim\Desktop\macro\Ingeniero Ventas Equipos.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveCell.FormulaR1C1 = "Ingeniero Ventas Equipos"
Sheets("Hoja1").Select
Sheets("Hoja1").Name = "Ingeniero Ventas Equipos"
ActiveWorkbook.Save
ActiveWindow.SmallScroll Down:=-18
Range("A2").Select
ActiveWindow.Close
Sheets("SOD1").Select
Cells.Select
'Range("A42").Activate'
Selection.Delete Shift:=xlUp
Cells.Select
'Range("A42").Activate'
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("SOD2").Select
Cells.Select
'Range("A37").Activate'
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("DATOS1").Select
Cells.Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-3
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("DATOS2").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("SOD1").Select
ActiveCell.Offset(1, 0).Select
' Next
End Sub
Analista de Respuestos.xlsx
RIESGOS VERSION FINAL_OPERACIONES.xlsx Libro1.xlsm Libro1.xlsm
Editado el por viniciusmauser