Capturar datos de un libro de Excel y guardarlo en otro libro

1 post / 0 nuevos
Jacifuentes521
Imagen de Jacifuentes521
Offline
última acción: Hace 6 meses 1 semana
alta: 08/02/2022 - 21:35
Puntos: 25
Capturar datos de un libro de Excel y guardarlo en otro libro

Buenas.

Tengo un libro de Excel (es un ejemplo) donde hay varias hojas con datos y en la hoja "Inconsistencias" es donde quedan los datos que captura de las demás hojas.

Queda así (imagen):

https://ibb.co/3Mgdyvs

Lo que necesito es que esos datos NO queden en la hoja "Inconsistencias", sino en otro libro aparte (el nombre del nuevo libro puede ser cualquiera porque ya tengo creada la opción de que el nombre del libro el usuario lo pueda guardar como desee). (La hoja "Inconsistencias" tiene que quedar con unos comentarios predeterminados que después pondré).

Éste es el código que tengo:

 

Sub ConsolidarInconsistencias() 
Dim Hoja As Worksheet, CON As Worksheet, Titulo As Range 
Application.ScreenUpdating = False 

Set CON = Sheets("Inconsistencias") 

'Traer datos con las inconsistencias que están en color amarillo 
CON.Range("A2:K" & CON.Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents 
For Each Hoja In Sheets 
With Hoja 
If Not Hoja.Name = CON.Name Then 
'-- 
Set Titulo = Nothing 
For y = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1 
If Hoja.Name Like .Cells(1, y) & "*" Then 
Set Titulo = .Cells(1, y) 
Exit For 
End If 
Next 
'-- 
If Not Titulo Is Nothing Then 
For x = 2 To .Cells(Rows.Count, Titulo.Column).End(xlUp).Row 
If .Cells(x, Titulo.Column).Interior.Color = vbYellow Then 
fila = CON.Range("B" & Rows.Count).End(xlUp).Row + 1 
CON.Range("A" & fila).HorizontalAlignment = xlCenter 
CON.Range("B" & fila) = .Range("A" & x) 
CON.Range("F" & fila) = .Cells(Titulo.Column) 
CON.Range("H" & fila).Font.Color = vbRed 
CON.Range("H" & fila).HorizontalAlignment = xlCenter 
'Traer la escala en caso que exista 
If .Range("B" & x).Font.Color = vbRed Then 
CON.Range("H" & fila) = .Range("B" & x) 
End If 
'Fin de traer escala 
CON.Range("I" & fila) = .Cells(x, Titulo.Column) 
CON.Range("I" & fila).Interior.Color = vbYellow 
CON.Range("J" & fila) = .Cells(x, Titulo.Column).Offset(0, 1) 
End If 
Next 
End If 
End If 
End With 
Next 
'Fin de traer datos de las inconsistencias*** 

'Contar errores 
Worksheets("Inconsistencias").Select 
Final = Application.CountA(Worksheets("Inconsistencias").Range("B:B")) 
For I = 2 To Final 
'Contamos las veces que se repiten cada uno de la cantidad de errores 
CantidadErrores = Worksheets("Inconsistencias").Cells(I, 2).Value 
Worksheets("Inconsistencias").Cells(I, 1).Value = Application.CountIf(Worksheets("Inconsistencias").Range("B1:B" & Final), CantidadErrores) 
Next 
'Fin de contar errores*** 

'Listar preguntas 
Dim cont As Long 
Dim ultLinea As Long 
Dim pregunta As Variant 
Dim nom_preg As Variant 
Dim rango As Variant 

ultLinea = Sheets("Inconsistencias").Range("F" & Rows.Count).End(xlUp).Row 

Set rango = Sheets("Variables").Range("A:E") 

For cont = 2 To ultLinea 
nom_preg = Sheets("Inconsistencias").Cells(cont, 6) 
pregunta = Application.VLookup(nom_preg, rango, 5, False) 

If IsError(pregunta) Then 
pregunta = 0 
End If 
 
Sheets("Inconsistencias").Cells(cont, 7) = pregunta 
 
Next cont 
'Fin de listar preguntas*** '
Crear hoja aparte 
Application.DisplayAlerts = False 
Workbooks.Add ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 
ActiveSheet.Name = "Inconsistencias Consolidadas" 
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 
ActiveSheet.Name = "Cuenta de Errores x Enc(COPIAR)" 
 
For Each she In Worksheets 
a = she.Name 
If a <> "Inconsistencias Consolidadas" And a <> "Cuenta de Errores x Enc(COPIAR)" Then she.Delete 
Sheets("Inconsistencias Consolidadas").Select 
Next 
 
With Range("A1:K1") 
.Value = Array("Cantidad de Errores", "SbjNum", "Status", "Fechas", "Srvyr", "Variables", "Preguntas", "Escala", "Menciones", "Inconsistencias", "Solución de Comercial") 
.Font.Bold = True 
End With 
'Fin hoja aparte*** 
 
End Sub


En la parte del código vba donde dice "'Crear hoja aparte" ya está codificado para que me guarde el libro, con dos hojas y los encabezados que debe tener, solo necesito que en dicho libro quede guardado los datos que se capturaron en el otro libro.

Me es muy útil su ayuda. Gracias.

Adjunto el archivo de ejemplo:

Etiquetas: