Ja sam zamislio da makro startuješ iz falja (i aktivnog lista) u koji ubacuješ podatke (u ovaj). U tom slučaju dodaj sledeći kod u novi modul i snima sa ekstenzijom
xlsm (Makro-Enabled Workbook )
Code:
Option Explicit
Sub Import()
' Makro koji azurira podatke u tabeli podacima iz izabranog opsega (spoljna tabela)
' Makro se startuje sa lista u koji se uvoze podaci
' Kolona A su imena prodavaca, kolona B Target, kolona C Ostaveren
' P. Jovanovic za elitesecurity.org
'
Dim rgDest As Range
Dim rgSource As Range
Dim rw As Variant
Dim rwUpis As Long
Set rgDest = ActiveSheet.UsedRange
' Izbegavanje greske kad se klikne Cancel
On Error Resume Next
Set rgSource = Application.InputBox("Izaberi opseg iz koga se preuzimaju podaci", Title:="Source Range", Type:=8)
' Aktiviraju se greske ponovo
On Error GoTo 0
' Ako nista nije selektovano izadji
If rgSource Is Nothing Then GoTo Kraj
' Prebacuje podatke red po red
Set rgSource = rgSource.Resize(rgSource.Rows.Count, 1) ' Uzima se samo prva kolona iz selekcije
If rgSource.Cells(1, 1).Value = "PRODAVAC" Then
Set rgSource = rgSource.Offset(1, 0).Resize(rgSource.Rows.Count - 1, 1)
End If
For Each rw In rgSource.Rows
'Debug.Print rw.Cells(1, 1).Value
If Len(rw.Cells(1, 1).Value) = 0 Then GoTo Sledeci
rwUpis = FindInList(rw.Cells(1, 1).Text, rgDest)
If rwUpis = 0 Then
rwUpis = rgDest.Rows.End(xlDown).Row + 1
rgDest.Cells(rwUpis, 1).Value = rw.Cells(1, 1).Value
End If
' Target i Ostvareno
rgDest.Cells(rwUpis, 2).Value = rw.Cells(1, 1).Offset(0, 1).Value
rgDest.Cells(rwUpis, 3).Value = rw.Cells(1, 1).Offset(0, 2).Value
Sledeci:
Next rw
MsgBox "Import završen", vbInformation, Title:="Kraj"
Kraj:
End Sub
Private Function FindInList(item As String, rng As Range) As Long
' Pomocna funkcija koja trazi da li postoji item u rng
' Ako postoji vraca broj reda u suprotnom 0
Dim c As Variant
FindInList = 0
Set c = rng.Find(item, LookIn:=xlValues)
If Not c Is Nothing Then
FindInList = c.Row
End If
End Function
Nakon startovanja (Alt+F8, ili napravi prečicu) treba izabrati opseg iz druge sveske (iz ovog) - moze ceo opseg ili samo imena
I linija po linija se prenosi na aktivni list. Na kraju se ispisuje poruka da je završeno
Nije to loše Rembrante, samo što ne bi dodao još malo boje?