Copiar celdas de diferentes columnas sin repetir información
publicado
Buen Día,
Necesito una ayudita por favor, lo que sucede es que eh estado buscando una macro que me ayude a copiar información de un libro a otro, yo se que hay miles de códigos y formas, la cuestión es que necesito que me copie diferentes columnas y ademas de eso como el proceso se repite cada vez que se corre la macro necesito que me copie solo la información nueva de las columnas o las que estén cambiadas, mi archivo tiene muchas columnas pero solo debo copiar unas cuantas, en todos los archivos hay exactamente el mismo numero de columnas están organizados igual y se llaman igual, y solo hay un archivo en donde se van a copiar los datos los otros son la fuente simplemente donde se ingresa información nueva, eh buscado y tengo esto hasta el momento pero no me funciona aun (yo soy principiante en esto y eh encontrado muchas cosas y las eh ido juntando lógicamente según mi criterio pero en realidad sigo sin hacer que me funcione), les agradecería mucho si me pueden ayudar.
Sub AACargarArchivos()
'Mostrar Interfase
DoEvents
UserForm1.Show
'Iniciar variable Archivos
Archivos = "** "
'Bloquear visualización de pantalla
Application.ScreenUpdating = False
'Iniciar las variables de arranque con el fin de recorrer todos los archivos de la carpeta
Buen Día,
Necesito una ayudita por favor, lo que sucede es que eh estado buscando una macro que me ayude a copiar información de un libro a otro, yo se que hay miles de códigos y formas, la cuestión es que necesito que me copie diferentes columnas y ademas de eso como el proceso se repite cada vez que se corre la macro necesito que me copie solo la información nueva de las columnas o las que estén cambiadas, mi archivo tiene muchas columnas pero solo debo copiar unas cuantas, en todos los archivos hay exactamente el mismo numero de columnas están organizados igual y se llaman igual, y solo hay un archivo en donde se van a copiar los datos los otros son la fuente simplemente donde se ingresa información nueva, eh buscado y tengo esto hasta el momento pero no me funciona aun
(yo soy principiante en esto y eh encontrado muchas cosas y las eh ido juntando lógicamente según mi criterio pero en realidad sigo sin hacer que me funcione), les agradecería mucho si me pueden ayudar.
Sub AACargarArchivos()
'Mostrar Interfase
DoEvents
UserForm1.Show
'Iniciar variable Archivos
Archivos = "** "
'Bloquear visualización de pantalla
Application.ScreenUpdating = False
'Iniciar las variables de arranque con el fin de recorrer todos los archivos de la carpeta
carpeta = "D:\Users\samira.triana\Desktop\PACC-EJEMPLO"
Cap = Right(carpeta, 1)
If Cap <> "\" Then
carpeta = carpeta & "\"
End If
Arch = Dir(carpeta)
'Seleccionar el archivo principal "PACC-Administrador" y la hoja "1. Formato PACC"
Windows("PACC-Administrador.xlsm").Activate
Sheets("1. Formato PACC").Select
'Quitar filtros en la hoja
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
'Ubicar la última celda llena de la base de datos
fil = Cells(1000000, 2).End(xlUp).Row + 1
'Averiguar el nombre del usuario del equipo actual
usuario = Environ("USERNAME")
'Direccionar a la carpeta
ChDir "D:\Users\samira.triana\Desktop\PACC-EJEMPLO"
'Verificar registros no cargados
Do While Arch <> ""
'Nuevo archivo a procesar
Arch = Dir
Archivos = Archivos & " * " & Arch
'Abrir el archivo que corresponda, según su orden dentro de la carpeta
'Ubicar la última celda llena de la base de datos
fil = Cells(1000000, 2).End(xlUp).Row + 1
On Error GoTo line2
Workbooks.Open Filename:=carpeta & Arch
'Presentar estado de avance
DoEvents
UserForm1.Show
DoEvents
UserForm1.Label1 = "Cargando el archivo: " & Arch
DoEvents
UserForm1.Label3 = Archivos
'Verificar último registro cargado para cargar los nuevos
fil1 = Cells(1000000, 61).End(xlUp).Row + 1
If fil1 = 6 Then
fil1 = fil1
Else
fil1 = fil1 - 1
End If
fil2 = Cells(1000000, 2).End(xlUp).Row
If fil1 >= 6 And fil2 > 5 Then
If fil1 = fil2 Then
If fil1 = 6 Then
GoTo line4
Else
GoTo line1
End If
End If
'Ubicar la última celda llena de la base de datos
line4:
'Seleccionar registros no cargados y pegar en el archivo principal
Range(Cells(fil1, 2), Cells(fil2, 33)).Copy
Windows("PACC-Administrador.xlsm").Activate
fil = Cells(1000000, 2).End(xlUp).Row + 1
Cells(fil, 2).Select
ActiveSheet.Paste
Windows("" & Arch & "").Activate
Range(Cells(fil1, 36), Cells(fil2, 36)).Copy
Windows("PACC-Administrador.xlsm").Activate
Cells(fil, 36).Select
ActiveSheet.Paste
Windows("" & Arch & "").Activate
Range(Cells(fil1, 46), Cells(fil2, 49)).Copy
Windows("PACC-Administrador.xlsm").Activate
Cells(fil, 46).Select
ActiveSheet.Paste
Windows("" & Arch & "").Activate
Range(Cells(fil1, 64), Cells(fil2, 67)).Copy
Windows("PACC-Administrador.xlsm").Activate
Cells(fil, 64).Select
ActiveSheet.Paste
Windows("" & Arch & "").Activate
'Registrar fecha y hora de actualización de archivos
Range(Cells(fil1, 67), Cells(fil2, 67)) = "Descargado el " & Now()
Range(Cells(fil1, 67), Cells(fil2, 67)).Copy
Windows("PACC-Administrador.xlsm").Activate
Cells(fil, 68).Select
ActiveSheet.Paste
Columns(ActiveCell.Column).EntireColumn.AutoFit
Windows("" & Arch & "").Activate
Columns(ActiveCell.Column).EntireColumn.AutoFit
'Salvar el archivo cargado y cerrarlo
ActiveWorkbook.Save
ActiveWorkbook.Close
GoTo line3
End If
'Salvar el archivo cargado y cerrarlo
line1:
ActiveWorkbook.Save
ActiveWorkbook.Close
line3:
Loop
line2:
Unload UserForm1
End Sub