Como copiar celdas especificas de un archivo a otro con macro

No puedo ver tu tabla pero entiendo tu problema. Tienes dos caminos

1) Podrías utilizar variables, en lugar de un copiado y pegado

Sub Copia_pega

fecha = Range("A1").value

Nombre = Range("B1").value

Apellido = Range("C1").value

Edad = Range("D1").value

Sheets("Tabla2").select

Range("A1").value = edad

Range("B1").value = Apellido

Range("C1").value = Nombre

Range("D1").value = fecha

End sub

SI te fijas cambie el orden para pegar la información, con el uso de variables no me limita el orden de los datos, claro que el problema podría ser, si tienes muchos datos, ya que serían muchas variables.

Otra opción es crear un buscador con referencia a los títulos con un next o con Do, para que recorra todas las columnas copiando y pegando según la coincidencia, el contra de esto es que los títulos entre los dos archivos deben ser exactamente iguales, y si algún titulo se repite tampoco funciona, por eso te ejemplifico solo la primera vía.

te explico otra vez para que veas las tablas

Hola buenos días tengo el siguiente problema tengo dos archivos uno con información
y el otro vació lo que intento hacer es copiar de un archivo al otro pero mi complicación es que el encabezado o el orden varían el uno del otro pongo el siguiente ejemplo en el
archivo 1 tengo la siguiente estructura.

Tabla 1

Código usuario Nombre Apellido Ocupación Ciudad Teléfono

01 Carlos ramírez medico Moscú 012234566

02 Andrea Jimenez ingeniero New york 54654646

03 Felipe García arquitecto Miami 458996664

Tabla 2

Aca debo copiar la información de la estructura 1 lo que necesito es una macro que me copie y pegue donde yo lo especifique por ejemplo todos lo nombres de la celda a la estructura 2 en el campo nombre y asi con todos los otros agradezco su ayuda cualquier inquietud por favor me dicen

Ocupación Apellido Nombre Cedula Código usuario Teléfono Ciudad

Ok, este código hace lo que necesitas:

Sub copia_pega()
Dim Comprobar, Contador
Comprobar = True: Contador = 1 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
Sheets("Tabla1").Select
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
Codigo = Range("A" & Contador).Value
Usuario = Range("B" & Contador).Value
Nombre = Range("C" & Contador).Value
Apellido = Range("D" & Contador).Value
Ocupacion = Range("E" & Contador).Value
Ciudad = Range("F" & Contador).Value
Telefono = Range("G" & Contador).Value
Sheets("Tabla2").Select
k = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & k).Value = Ocupacion
Range("B" & k).Value = Apellido
Range("C" & k).Value = Nombre
Range("D" & k).Value = Cedula
Range("E" & k).Value = Codigo
Range("F" & k).Value = Usuario
Range("G" & k).Value = Telefono
Range("H" & k).Value = Ciudad

Hola estoy probando la macro y me saca un error en

Sheets("Libro1").Select

Se ha producido el error ´9´ en tiempo de ejecución

el error dice subíndice fuera del intervalo

te mando el código como lo adapte

Sub copia_pega()
Dim Comprobar, Contador
Comprobar = True: Contador = 1 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
Sheets("Libro1").Select
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
NumeroDocumentoEntidadContratista = Range("A" & Contador).Value
NumeroContrato = Range("B" & Contador).Value
PrimerNombreEducadorFamiliar = Range("C" & Contador).Value
PrimerApellidoEducadorFamiliar = Range("D" & Contador).Value
Sheets("Libro2").Select
k = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & k).Value = PrimerNombreEducadorFamiliar
Range("B" & k).Value = PrimerApellidoEducadorFamiliar
Range("C" & k).Value = NumeroDocumentoEntidadContratista
Range("D" & k).Value = NumeroContrato
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente del bucle externo.
End Sub

me sale un error en la compilación de la macro error dice subíndice fuera del intervalo te paso el código como lo organice.

Sub copia_pega()
Dim Comprobar, Contador
Comprobar = True: Contador = 1 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
Sheets("Libro1").Select
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
NumeroDocumentoEntidadContratista = Range("A" & Contador).Value
NumeroContrato = Range("B" & Contador).Value
PrimerNombreEducadorFamiliar = Range("C" & Contador).Value
PrimerApellidoEducadorFamiliar = Range("D" & Contador).Value
Sheets("Libro2").Select
k = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & k).Value = PrimerNombreEducadorFamiliar
Range("B" & k).Value = PrimerApellidoEducadorFamiliar
Range("C" & k).Value = NumeroDocumentoEntidadContratista
Range("D" & k).Value = NumeroContrato
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente del bucle externo.
End Sub

Ok, el código Sheets no es para libros es para hojas, en todo caso el código para libros es:

Windows("Libro1.xlsm").Activate

Sheets("Aquí debes colocar el nombre de la hoja que tienes"

Windows("Libro2.xlsm").Activate

Sheets("Aquí debes colocar el nombre de la hoja que tienes"

El problema va a depender del tipo de office que tengas, ya que he tenido problemas con estas lineas en algunos office, en todo casi cambia, prueba y me avisas.

Otra opción, pero solo sirve si tienes solo los dos archivos abiertos es con ActiveWindow. ActivateNext, y el código quedaría así.

Sub copia_pega()
Dim Comprobar, Contador
Comprobar = True: Contador = 1 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
Sheets("aquí debe ir el nombre de la hoja").Select
If Range("A" & Contador).Value <> "" Then ' Si la condición es verdadera.
NumeroDocumentoEntidadContratista = Range("A" & Contador).Value
NumeroContrato = Range("B" & Contador).Value
PrimerNombreEducadorFamiliar = Range("C" & Contador).Value
PrimerApellidoEducadorFamiliar = Range("D" & Contador).Value
ActiveWindow.ActivateNext

Sheets("aquí debe ir el nombre de la hoja no del libro").Select
k = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & k).Value = PrimerNombreEducadorFamiliar
Range("B" & k).Value = PrimerApellidoEducadorFamiliar
Range("C" & k).Value = NumeroDocumentoEntidadContratista
Range("D" & k).Value = NumeroContrato

ActiveWindow.ActivateNext

oye ,me sale error de sintaxis ayuda por favor

cuando ejecuto la macro me sale un error de sintaxis ayuda

Pásame los códigos como los tienes, debes tener un error en algún nombre

Te voy a pasar el archivo final el cual necesito para que veas como se debe de implementar del que debo extraer se llama archivo 1 y al que debo copiar se llama archivo 2

Mira que el archivo 1 todas las celdas terminan con un * todas las celdas del archivo 1 se deben de copiar en el archivo dos pero lo que pasa es que el archivo dos tiene nas celdas que no se llenan entonces solo se llenan con las del archivo 1 mira que el archivo dos en sus celdas también aparece nombre* entonces todo lo que termine en * del archivo dos se debe de reemplazar con lo del archivo 1 te mando el código y los archivos adjuntos te agradezco tu ayuda.

Sub copia_pega()
Dim Comprobar, Contador
Comprobar = True: Contador = 1 ' Inicializa variables.
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
Sheets("aquí debe ir el nombre de la hoja").Select
If Range("B" & Contador).Value <> "" Then ' Si la
condición es verdadera.
NOMBRES* = Range("B"
& Contador).Value
APELLIDOS* = Range("C" & Contador).Value
TIPO DOCUMENTO* = Range("D" & Contador).Value
NUM. DOCUMENTO*= Range("E" & Contador).Value
GENERO*= Range("F" & Contador).Value
ESTADO CIVIL*= Range("G" & Contador).Value
PAÍS NAC.*= Range("H" & Contador).Value
DEP. NAC.*= Range("I" & Contador).Value
MUNC. NAC.*= Range("J" & Contador).Value
ZONA*= Range("K" & Contador).Value
PAÍS RES.*= Range("L" & Contador).Value
DEP. RES.*= Range("M" & Contador).Value
MUN. RES.*= Range("N"
& Contador).Value
OCUPACIÓN*= Range("O" & Contador).Value
ACCESO A INTERNET*= Range("P" & Contador).Value
PROGRAMA* AL QUE INGRESA= Range("Q" & Contador).Value
F. DILIGENCIAMIENTO*= Range("R"
& Contador).Value
ULTIMO AÑÓ ESTUDIOS*= Range("S" & Contador).Value
ETNIA*= Range("T" & Contador).Value
ActiveWindow.ActivateNext
Sheets("aquí debe ir el nombre
de la hoja no del libro").Select
k = Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & k).Value
= NOMBRES*
Range("B" & k).Value = APELLIDOS*
Range("C" & k).Value = TIPO DOCUMENTO*
Range("D" & k).Value = NUM. DOCUMENTO*
Range("F" & k).Value = GENERO*
Range("J" & k).Value = ESTADO CIVIL*
Range("K" & k).Value = PAÍS NAC.*
Range("L" & k).Value = DEP. NAC.*
Range("M" & k).Value = MUNC. NAC.*
Range("N" & k).Value = ZONA*
Range("O" & k).Value = PAÍS RES.*
Range("P" & k).Value = DEP. RES.*
Range("Q" & k).Value = MUN. RES.*
Range("W" & k).Value = OCUPACIÓN*
Range("Z" & k).Value = ACCESO A INTERNET*
Range("AY" & k).Value = PROGRAMA* AL QUE INGRESA
Range("AZ" & k).Value = F. DILIGENCIAMIENTO*
Range("BA" & k).Value = ULTIMO AÑÓ ESTUDIOS*
Range("BB" & k).Value = ETNIA*
ActiveWindow.ActivateNext
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente del bucle externo.
End Sub

Si quieres me puedes dar un correo para enviarte los archivos de ejemplo

1) En esta parte no has colocado el nombre de tu hoja

Sheets("aquí debe ir el nombre de la hoja").Select

2) Asumo que es un error en el copiado, pero estos códigos no están en dos lineas:? O Si

NOMBRES* = Range("B"
& Contador).Value

3) No estoy muy seguro pero pregunto, porque colocas "*" luego del nombre de las variables, eso puede estar molestando.

como hago para que lo que me copie al otro archivo me lo copie en formato valores me podrías decir que le agrego al código, gracias