Se quiser experimentar este código no lugar do seu, coloque o nome do país em 'H16' da planilha "Cadastro".
Vincule o código ao botão "Cadastrar" existente na planilha "Cadastro".
O código replica os dados na planilha "Lista de Cedulas Nacionais", cola cópia da bandeira do país escolhido, limpa os campos de origem.
Sub CadastraProdutosV2()
Dim LR As Long, cell As Range, k As Long, b As Long, fig As Shape
Application.ScreenUpdating = False
With Sheets("Lista de Cedulas Nacionais")
LR = .Cells(Rows.Count, 2).End(3).Row
For Each cell In Range("E6,E8,E10,E12,E14,E16,H6,H8,H10,H12,H14,H16")
.Cells(LR + 1, k + 2) = cell.Value
k = k + 1
Next cell
b = Sheets("Planilha1").[B:B].Find([H16]).Row
For Each fig In Sheets("Planilha1").Shapes
If Not Intersect(fig.TopLeftCell, Sheets("Planilha1").Cells(b, 3)) Is Nothing Then
fig.Copy
.Cells(LR + 1, k + 2).PasteSpecial
End If
Next
End With
Range("E6,E8,E10,E12,E14,E16,H6,H8,H10,H12,H14,H16").Value = ""
Application.ScreenUpdating = True
End Sub
Postado : 12/06/2016 6:09 pm