Visual Basic - Error macro excel copiar y pegar de 2 hojas diferentes

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil

Error macro excel copiar y pegar de 2 hojas diferentes

Publicado por Pedro canales (4 intervenciones) el 14/09/2023 01:39:56
Buena tardes estoy realizando un macro para poder copiar información de varios archivos en un carpeta
y pegarlos y consolidarlos en otra.
todos los datos que necesito están en un pestaña de esos archivos pero
también necesito otro dato que esta en otra pestaña.
La macro me funciona sin problema pero cuando intento agregar la variable
Ws2 para la otra hoja donde tomare el dato que me falta tomar de ahi no me lo permite.
¿Me pueden apoyar?

Este es mi codigo:
Sub ProcesarArchivosEnCarpeta()
Dim Carpeta As String
Dim Archivo As String
Dim Wb As Workbook
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim WsDestino As Worksheet
Dim FilaDestino As Long

' Definir la carpeta donde se encuentran los archivos
Carpeta = "C:\Users\OPER75\Documents\Prueba1" ' Cambia esto a la ruta de tu carpeta

' Inicializar la fila de destino en el archivo "Concentrado general IMSS"
Set Wb = ThisWorkbook ' Cambia esto al nombre de tu archivo actual
Set WsDestino = Wb.Sheets("Hoja2")
FilaDestino = WsDestino.Cells(WsDestino.Rows.Count, "B").End(xlUp).Row + 1

' Ciclo para recorrer los archivos en la carpeta
Archivo = Dir(Carpeta & "\*.xlsx") ' Cambia el tipo de archivo según tus necesidades

Do While Archivo <> ""
' Abrir el archivo
Set Wb = Workbooks.Open(Carpeta & "\" & Archivo)
Set Ws1 = Wb.Sheets("Datos trabajador")
Set Ws2 = Wb.Sheets("Datos Empresa")

' Copiar el dato de la celda B1 del archivo que abrió y pegarlo en la celda H de la Hoja 2 del archivo "Concentrado general IMSS"
Ws1.Range("B1").Copy WsDestino.Cells(FilaDestino, 8)
Ws2.Range("D3").Copy WsDestino.Cells(FilaDestino, 23)


' Realizar las sumas y pegar los resultados en Hoja 2 del archivo "Concentrado general IMSS"
WsDestino.Cells(FilaDestino, 7).Value = Application.WorksheetFunction.Sum(Ws1.Range("N3:T3", Ws1.Range("T3").End(xlDown)))
WsDestino.Cells(FilaDestino, 10).Value = Application.WorksheetFunction.Sum(Ws1.Range("AG3:AJ3", Ws1.Range("AJ3").End(xlDown)))
WsDestino.Cells(FilaDestino, 9).Value = WsDestino.Cells(FilaDestino, 7).Value - WsDestino.Cells(FilaDestino, 10).Value
WsDestino.Cells(FilaDestino, 11).Value = Application.WorksheetFunction.Sum(Ws1.Range("Y3", Ws1.Range("Y3").End(xlDown)))
WsDestino.Cells(FilaDestino, 12).Value = Application.WorksheetFunction.Sum(Ws1.Range("AA3", Ws1.Range("AA3").End(xlDown)))
WsDestino.Cells(FilaDestino, 13).Value = Application.WorksheetFunction.Sum(Ws1.Range("AB3", Ws1.Range("AB3").End(xlDown)))
WsDestino.Cells(FilaDestino, 14).Value = Application.WorksheetFunction.Sum(Ws1.Range("AE3", Ws1.Range("AE3").End(xlDown)))
WsDestino.Cells(FilaDestino, 15).Value = Application.WorksheetFunction.Sum(Ws1.Range("AF3", Ws1.Range("AF3").End(xlDown)))
WsDestino.Cells(FilaDestino, 22).Value = Application.WorksheetFunction.Count(Ws1.Range("H3", Ws1.Range("H3").End(xlDown)))


' Cerrar el archivo sin guardar cambios
Wb.Close SaveChanges:=False

' Incrementar la fila de destino
FilaDestino = FilaDestino + 1

' Obtener el siguiente archivo en la carpeta
Archivo = Dir
Loop
End Sub


El error esta en negritas
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 1.259
Plata
Ha mantenido su posición en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Error macro excel copiar y pegar de 2 hojas diferentes

Publicado por Antoni Masana (558 intervenciones) el 14/09/2023 18:41:04
El fichero que abres ha de tener las siguientes hojas para que funcione:

- Datos trabajador
- Datos Empresa


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub ProcesarArchivosEnCarpeta()
    Dim Carpeta As String
    Dim Archivo As String
    Dim Wb As Workbook
    Dim Ws1 As Worksheet
    Dim Ws2 As Worksheet
    Dim WsDestino As Worksheet
    Dim FilaDestino As Long
 
    ' ---&---  Definir la carpeta donde se encuentran los archivos
    Carpeta = "C:\Users\OPER75\Documents\Prueba1" ' ---&---  Cambia esto a la ruta de tu carpeta
 
    ' ---&---  Inicializar la fila de destino en el archivo "Concentrado general IMSS"
    Set Wb = ThisWorkbook ' ---&---  Cambia esto al nombre de tu archivo actual
    Set WsDestino = Wb.Sheets("Hoja2")
    FilaDestino = WsDestino.Cells(WsDestino.Rows.Count, "B").End(xlUp).Row + 1
 
    ' ---&---  Ciclo para recorrer los archivos en la carpeta
    Archivo = Dir(Carpeta & "\*.xlsx") ' ---&---  Cambia el tipo de archivo según tus necesidades
 
    Do While Archivo <> ""
        ' ---&---  Abrir el archivo
        Set Wb = Workbooks.Open(Carpeta & "\" & Archivo)
        Set Ws1 = Wb.Sheets("Datos trabajador")
        Set Ws2 = Wb.Sheets("Datos Empresa")
 
        ' ---&---  Copiar el dato de la celda B1 del archivo que abrió y pegarlo en la celda H de la Hoja 2 del archivo "Concentrado general IMSS"
        Ws1.Range("B1").Copy WsDestino.Cells(FilaDestino, 8)
        Ws2.Range("D3").Copy WsDestino.Cells(FilaDestino, 23)
 
         ' ---&---  Realizar las sumas y pegar los resultados en Hoja 2 del archivo "Concentrado general IMSS"
        With Application.WorksheetFunction
            WsDestino.Cells(FilaDestino,  7).Value = .Sum(Ws1.Range("N3:T3", Ws1.Range("T3").End(xlDown)))
            WsDestino.Cells(FilaDestino, 10).Value = .Sum(Ws1.Range("AG3:AJ3", Ws1.Range("AJ3").End(xlDown)))
            WsDestino.Cells(FilaDestino,  9).Value = WsDestino.Cells(FilaDestino, 7).Value - WsDestino.Cells(FilaDestino, 10).Value
            WsDestino.Cells(FilaDestino, 11).Value = .Sum(Ws1.Range("Y3", Ws1.Range("Y3").End(xlDown)))
            WsDestino.Cells(FilaDestino, 12).Value = .Sum(Ws1.Range("AA3", Ws1.Range("AA3").End(xlDown)))
            WsDestino.Cells(FilaDestino, 13).Value = .Sum(Ws1.Range("AB3", Ws1.Range("AB3").End(xlDown)))
            WsDestino.Cells(FilaDestino, 14).Value = .Sum(Ws1.Range("AE3", Ws1.Range("AE3").End(xlDown)))
            WsDestino.Cells(FilaDestino, 15).Value = .Sum(Ws1.Range("AF3", Ws1.Range("AF3").End(xlDown)))
            WsDestino.Cells(FilaDestino, 22).Value = .Count(Ws1.Range("H3", Ws1.Range("H3").End(xlDown)))
        End With
 
        ' ---&---  Cerrar el archivo sin guardar cambios
        Wb.Close SaveChanges:=False
 
        ' ---&---  Incrementar la fila de destino
        FilaDestino = FilaDestino + 1
 
        ' ---&---  Obtener el siguiente archivo en la carpeta
        Archivo = Dir
    Loop
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar