Macro para copiar celdas con condición

[Cocko]

Buenos días/tardes/noches..
Por falta de conocimientos y tiempo para adquirirlos en este momento recurro a ustedes.. Desde ya mil gracias..

Estoy trabajando en un libro excel de stock, en la hoja "Stock" tengo una tabla cuyos datos abarcan A7:D56, con las columnas:
Concepto (A) Stock (C) Mínimo (D) Máximo (E)

.

Necesitaría una macro que copie el Concepto (A) y el resultado de la restar el máximo (E) menos el Stock (C) sólo de las celdas en la que el Stock (C) sea igual o menor al Mínimo (D), y pegarlos en la hoja "Lista de compras" con columnas:
Concepto (A) Cantidad (C)
cuya tabla abarca A6:C55, teniendo en cuenta que pueden existir datos por haber ejecutado la macro anteriormente, por lo que sería conveniente que se borren todos los valores de esta tabla manteniendo el formato de destino antes de realizar la copia.

Es esto posible?

Perdón a quien moleste y muchas gracias.

[Perr0]

Hola Cocko, muchos tendrán respuesta a tu pregunta, pero la idea del foro es ayudar a la gente que tiene construido algo, por lo que estas pidiendo (partir de cero), creo es mas fácil que contrates los servicios de alguien?

saludos

[mrocf]

Hola! Cocko (y Perr0)
Al no subir tu archivo de muestra, hay que estar adivinando -aproximadamente- un 68,32% de la información que se requiere para ayudarte.

Aún así, y si te esmeras depurando el código que te voy a mostrar, creo que podrás resolver tu problema:

Código PHP:

  Sub a_Lista_de_Compras()
Dim Q&
Application.ScreenUpdating = False
With Sheets("Lista de compras")
  Q = WorksheetFunction.Max(7, .Cells(.Rows.Count, "a").End(xlShiftUp).Row)
  .Range("a6", "c" & Q).Delete xlShiftUp
End With
With ActiveSheet
  Q = WorksheetFunction.Max(8, .Cells(.Rows.Count, "a").End(xlUp).Row) - 6
  Workbooks.Add xlWBATWorksheet
  [a1:e1].Resize(Q) = .[a7:e7].Resize(Q).Value
  [c1].Resize(Q).Insert xlShiftToRight
  [c1] = "Cantidad"
  [h2] = "=D2<=E2"
  With [c2].Resize(Q - 1)
    .Formula = "=f2 - d2"
    .Value = .Value
  End With
  Range("a1:e" & Q).AdvancedFilter 2, [h1:h2], [j1], False
  With .Parent.Sheets("Lista de compras")
    If [j2] <> "" Then [j1].CurrentRegion.Resize(, 3).Copy .[a6]
    ActiveWorkbook.Close False
    Application.Goto .[a6]
  End With
End With
Application.ScreenUpdating = True
End Sub  
   

Saludos, Cacho R.