MS Excel

Tak jsem zkoušel a zkoušel sám, inspiroval se zdejšími řešeními co jsem našel a splodil svoje makro. Funguje zatím výtečně. Prvně jsem tam měl kopírováni hodnot a poté pastespecial xlvalues. Jenze to bylo u 13000 řádků velice pomalé. Ještě budu muset vymyslet, ať to není vázané na číslo sloupce, ale ať si ho prvně vyhledá podle názvu. Ale nato se vrhnu asi až v pondělí :-)

Takže ve zkratce co makro dělá. Otevře si zdrojový dokument, vyhledává v něm hodnoty a přiřazuje je k konkrétním položkám v prvním dokumentu. Ještě porovná a když dochází ke změně, označí hodnotu žlutě. nenalezenou hodnotu označí červeně. Až vše projde, tak zdrojový dokument zavře a dá hlášku že data byla aktualizována.

Kdyby někdo zkušenější měl jakoukoliv radu co by to ještě vylepšila, tak sem s ní :-)

Sub kopiruj()
Dim i, Radek As Long
Dim ZDROJ As String
Dim CIL As String
Dim cesta As String

CIL = ActiveWorkbook.Name 'pod promennou cil ulozi jmeno

cesta = Application.GetOpenFilename 'okno k zadani cesty zdrojoveho dokumentu
If cesta = "False" Then Exit Sub 'pokud je chyba, pak ukonci makro

Workbooks.Open cesta 'otevre zdrojovy dokument
ZDROJ = ActiveWorkbook.Name 'pod promennou zdroj ulozi nazev dokumentu

Workbooks(CIL).Activate 'da do popredi dokument ktery sosa data

Workbooks(CIL).Worksheets("List1").Range("DO8:DO65000").Interior.ColorIndex = 0 'zmeni barvu vsech bunek ve menenem sloupci na bez vyplne

On Error Resume Next
For i = 8 To Workbooks(CIL).Worksheets("List1").Cells(65000, 31).End(xlUp).Row 'od jedné do začne odspodu a zastaví se na první neprázdné buňce
If Len(Workbooks(CIL).Worksheets("List1").Cells(i, 118)) > 0 Then 'jestliže najde že tam něco je na konkrétním řásku (hodnota větší než 0 bytu)
Radek = Workbooks(ZDROJ).Worksheets("List1").Range("B1:B15000").Find(what:=Workbooks(CIL).Worksheets("List1").Cells(i, 118), lookat:=xlWhole).Row 'vyhleda hodnotu v zdroji informaci (v radku 1-15000). hodnotu z cile kam se maji dohrat data
If Err.Number = "91" Then
Workbooks(CIL).Worksheets("List1").Cells(i, 119).Interior.ColorIndex = 3 'kdyz nenajde, tak zacerveni
Else 'kdyz najde...
If Workbooks(CIL).Worksheets("List1").Cells(i, 119).Value <> Workbooks(ZDROJ).Worksheets("List1").Cells(Radek, 80).Value Then 'kdyz je hodnota rozdilna od predchozi
Workbooks(CIL).Worksheets("List1").Cells(i, 119) = Workbooks(ZDROJ).Worksheets("List1").Cells(Radek, 80).Value 'tak se prepise novou
Workbooks(CIL).Worksheets("List1").Cells(i, 119).Interior.ColorIndex = 6 'a zazluti
End If
End If
End If
'Radek = 0
Err.Number = 0 'vynuluje moznou chybu z hledani
Next i
On Error GoTo 0
Workbooks(ZDROJ).Close SaveChanges:=False 'zavre zdrojovy dokument
MsgBox ("Data aktualizována") 'poda informaci...citovat