Necesito macro para actualizar datos de un libro a otro con una columna común a ambos.

Vamos allá. Voy a partir de que seleccionas un ID del libro proveedor, es decir, seleccionas una celda en concreto (no solicito el ID), que el libro MiTarifa está en la misma carpeta que el libro Proveedor (y no tiene password de apertura) y para la ejecución de la macro, tienes pensado crearte un botón de formulario o asociar una macro a una celda.

Con estas suposiciones preliminares, create un módulo en el proyecto VBA pero ojo! Del libro Proveedor (Alt+F11) y pega este código:

Option Explicit
Global libro As String, ruta As String

Function buscar(ByRef r, cod As Long) As Boolean

On Error GoTo fin
Dim i As Integer, r1 As Integer
'compruebo si ya está abierto sino lo abro If libro_abierto(libro) = False Then

'abro el libro MiTarifa. Donde pone password, pondría la de apertura entre las comillas 'selecciono el libro y me coloco en la columna ID

Workbooks.Open FileName:=(ruta & "\" & libro), Password:=""

Range("A1").Select

Else:

'como ya esta abierto, lo activo y me coloco en la columna ID

Workbooks(libro).Activate

Range("A1").Select

End If

'con el libro y la columna seleccionada inicio la busqueda

'inicio variables

i = 0

r1 = ActiveCell.Row

Do While Cells(r1 + i, 1).Value <> cod And Cells(r1 + i, 1).Value <> ""

i = i + 1

Loop

If Cells(r1 + i, 1).Value = cod Then

'modifico la variable r para poder luego insertar

r = r1 + i

buscar = True

Exit Function

Else:

'ID no encontrado. Cierro el libro MiTarifa

Workbooks(libro).Close savechanges:=False

buscar = False

Exit Function

End If

'Caso de no encontrar el libro MiTarifa

fin:

buscar = False

End Function

Sub insertar(r, nom, desc, peso)

'me ubico en la celda Id del libro MiTarifa

Cells(r, 1).Select

'inserto los valores columna c:3, columna s:19, columna v:22

Cells(r, 3).Value = nom

Cells(r, 19).Value = peso

Cells(r, 22).Value = desc

End Sub

Function libro_abierto(libro As String) As Boolean

Dim wb As Workbook

For Each wb In Application.Workbooks

If UCase(wb.Name) = UCase(libro) Then

libro_abierto = True

Exit Function

End If

Next wb

libro_abierto = False

End Function

Sub principal()

On Error Resume Next
Dim cod As Long, peso As Integer, r As Integer

Dim nombre As String, descripcion As String

Application.ScreenUpdating = False

'asigno el ID a cod y su fila a r porque la columna es la A

cod = ActiveCell.Value

r = ActiveCell.Row

'asigno los valores de descripcion, nombre y peso

descripcion = Cells(r, 2).Value

nombre = Cells(r, 3).Value

peso = Cells(r, 4).Value

'asigno la dirección de la carpeta del libro Proveedor (que debe coincidir con MiTarifa) a ruta ruta = ThisWorkbook.Path

'asigno el nombre del libro MiTarifa a libro

libro = "MiTarifa.xlsx"

'busco el codigo en el libro MiTarifa

If buscar(r, cod) = False Then

'si es negativo, lanzo el mensaje y abandono

MsgBox "Código no encontrado o no existe el libro " & libro, vbOKOnly + vbInformation

Exit Sub

'sino, inserto los parámetros

Else: Call insertar(r, nombre, descripcion, peso)

MsgBox "Los valores nombre, descripción y peso del código ID: " & cod & vbCrLf & _ "han sido modificados correctamente en el libro " & libro

'guardo el libro MiTarifa

Workbooks(libro).Save

End If

End Sub

Buenas noches paisano.

Voy a ver que tal me va con ella y ya te cuento el sábado, ya que mañana me piro tres días de curro lejos de Sevilla.

Un saludo, y gracias de antemano.

Santiago.

De acuerdo. Te escribo porque he visto un error.

Donde dice:

'asigno la dirección de la carpeta del libro Proveedor (que debe coincidir con MiTarifa) a

ruta ruta = ThisWorkbook.Path

Debe decir:

'asigno la dirección de la carpeta del libro Proveedor (que debe coincidir con MiTarifa) a ruta

ruta = ThisWorkbook.Path

Sino jamás encontrará el directorio.

Hola, gracias por tu apunte.

Como te comenté hasta el sábado no estaré en disposición de colocarla y probarla, pero leyendo tu mensaje, me comentas que debo hacerlo desde una macro en Proveedor.xlsx.

Yo pretendía añadirlo a una macro que tengo confeccionada en otro fichero Macro.xlsm. No podría ser así, o necesitaría modificar algo de lo que me mandas ?.

Gracias de nuevo.

Ahora desde Valencia... pero en breve desde "el jota".

Saludos.

No hay problema de que copies el código en el fichero macro.xlsm. Ahora bien el código que te he escrito parte de una selección de ID de Proveedor, es decir, que para que te funcione debes plantearte estas pociones que más se ajusten a tu necesidad: 1.- puedes abrir el fichero proveedor, seleccionar un Id, luego abrir el libro macro y ejecutar el código, o

2.- Abrir el fichero macro y ejecutar el código solicitando el código ID sin haber abierto Proveedor,

Cada opción tiene su modificación al código que te he mandado pero la segunda opción requiere que los tres libros estén en el mismo directorio además de saber cual es el ID que necesitas.

¿Qué te aconsejo para no enfollonarte mucho? La primera opción que es sencilla de ejecutar y lo único que conllevaría sería abrir el libro Proveedor de antemano y seleccionar un Id. El resto, el código del libro macro haría el resto.

Vi tus imágenes y por lo que vi deberías hacer lo siguiente,

sub actualizar()

' Entrega la ultima fila escrita sirve para recorrer todo el archivo

Workbooks("MiTarifa.xlsx").activate

fila_tarifa = range("a65000").end(xlup).row

i = 2

do while i <= fila_tarifa

id_tarifa = cells(i,1).value

workbooks("Proveedor.xlsx").activate

fila_prov = range("a65000").end(xlup).row

j =2

do while j <= fila_prov

id_prov = cells(j,1).value

if id_prov = id_tarifa then

descripción = cells(j,2).value

nombre = cells(j,3).value

peso = cells(j,4).value

workbooks("MiTarifa.xlsx").activate

cells(i,22).value = descripción

cells(i,3).value = nombre

celld(i,19).value = peso

j = fila_prov + 100

end if

j = j + 1

loop

workbooks("MiTarifa.xlsx").activate

i = i + 1

loop

end sub

Hola.

Gracias por tu presteza e interés.

Mañana cuando llegue a mi ofi la probaré, y ya te cuento.

Un saludo.