
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
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


0