Copiar celdas de diferentes columnas sin repetir información

[samira]

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