¿Te atreves a demostrar lo que sabes resolviendo alguno de estos
temas abiertos/no resueltos?

Foros
Foros ImF
Macros VBA
Capturar datos de u...
 
Compartir:
Avisos
Vaciar todo

[Resuelto] Capturar datos de un libro de Excel y guardarlo en otro libro

 
    Último Mensaje
  RSS
 Jacifuentes521
(@jacifuentes521)
New Member

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:

 

Citar
Topic starter Respondido : 08/02/2022 10:24 pm
Etiquetas del debate
Macro macros vba foro excel ayuda excel facil
RET
 RET
(@ret)
Estimable Member Admin

@jacifuentes521,

 

Si ya tienes hecho todo hasta la creacion del libro de destino y solot e falta copiar los datos, lo único que tienes que hacer es:

- activar el libro origen

- seleccionar el rango que quieras copiar

- copiarlo al portapapeles (Rango.Copy)

- activar el libro de destino

- pegar los datos donde quieras

 

Otra opción sería que crees los objetos rango Origen y destino y después hagas un RangoOrigen.Copy Destination := RangoDestino

 

IMF_RET

https://InformaticaMuyFacil.com

ResponderCitar
Respondido : 09/02/2022 7:28 am
 Jacifuentes521
(@jacifuentes521)
New Member

@ret Con éste fragmento de código Worksheets(Array("Inconsistencias")).Copy ya quedaría listo. Solo que ¿Cómo hago para formatear (que quede todo en blanco) y ponerle unas frases en la hoja de donde procedían los datos en código VBA?

Que me quede algo así (teniendo en cuenta que el nombre del archivo donde se ejecuta la macro son diferentes porque se van a manejar muchos libros).

Gracias.

ResponderCitar
Topic starter Respondido : 09/02/2022 3:21 pm
RET
 RET
(@ret)
Estimable Member Admin

@jacifuentes521

 

Solo tienes que seleccionar en el código el libro y rango al que quieres acceder. Puedes hacerlo con Workbooks(NombreLibro).Range(Rango)

o puedes crear un objeto

Dim WbOrigen as Workbook

Set WbOrigen = Workbooks(NombreLibro)

Wborigen.Range(Rango)

 

IMF_RET

https://InformaticaMuyFacil.com

ResponderCitar
Respondido : 10/02/2022 8:41 am
 Jacifuentes521
(@jacifuentes521)
New Member

@ret Ya quedó solucionado. Gracias.

ResponderCitar
Topic starter Respondido : 11/02/2022 12:04 am

Dejar una respuesta

Nombre del autor

Correo electrónico del autor

Título *

 
Vista previa 0 revisiones Guardado
Ir al foro:
  Anterior debate
Siguiente debate  
Debates relacionados
Etiquetas del debate:  Macro (7) , macros (105) , vba (105) , foro (103) , excel (105) , ayuda excel facil (62) ,
Compartir: