Makro VBA kopírování z jiného sešitu

[Acce]

Dobrý den ahoj,

mohli byste mi prosím poradit ohledně maker v Excelu?? Už si nevím rady. Nějakým způsobem s VBA zvládám začátky, případně si makro nahraju záznamem.Tak se pokusím nejpřesněji popsat co přesně potřebuji.
Po spuštění makra v sešitu 1 se podle hodnot ve sloupci K podívá do neaktivního sešitu2(v dokumentech) a vyhledá stejné hodnoty, které jsou (v sešitu2) ve sloupci L a v případě nalezení shody zkopíruje ze sešitu2 buňku ze sloupce A do sešitu1 do sloupce L.

Předem děkuji za jakékoliv pokusy o pomoc.

[elninoslov]

2 príklady. V oboch sú použité na dolovanie dát vzorce, ktoré sú vložené makrom. Prvý počíta s rovnakým názvom listu prehľadávaného súboru, druhý počíta s tým, že list na prehľadanie je vždy prvý v poradí.

[Acce]

Vypadá, že nebude chybět moc a začne to fungovat, nicméně zatím tomu tak není....v prvním případě po výběru dokumentu se nestane vůbec nic, v případě druhém po nakliknutí souboru, v kterém by měl hledat, hodí chybu v řádku - With Workbooks.Open(Subor) ...Děkuji, vážím si toho

[elninoslov]

Zmente tie hodnoty A,c,d napr. na C,D,A, a stavím sa, že si všimnete rozdielne výsledky. Pozrite sa do Zošit2, či je usporiadaný ako ten Váš (ktorý nemáme). Dajte si BreakPoint (klik myši na tenký stĺpec vľavo od kódu) na riadok

Kód: Vybrat vše

Subor = VyberSubor

a makro si odkrokujte, sledujte výsledok.

Druhé makro - skúste si zmeniť ten "diskutabilný" riadok na

Kód: Vybrat vše

Workbooks.Open (Subor)
  With ActiveWorkbook

a rovnako si dajte BreakPoint na rovnaký riadok a makro si cez F8 po spustení odkrokujte.

U mňa fungujú obe. Tu bude záležať na informáciách, ktoré neposkytujete, verzia Office, skutočné rozmiestnenie dát, a pod.

[Acce]

Pokusný dokumenty už se rozběhly, super...teď to úspěšně zavést do ostré verze....Díky moc, nečekal sem, že mi někdo až takto pomůže. Jen ještě jedna drobnost, jelikož dokument, ze kterého se berou data, je pořád na jednom místě jak by vypadal řádek s kodem bez ručního zadání dokumentu, cesta by byla přímo v makru.... Díky...posílám alespoň pomyslného panáka borovičky...už teď jste mi opravdu pomohl

Dodatečně přidáno po 2 minutách 5 vteřinách:
verze office je 2007 (12.0.4518.1014), rozmístění dat ve sloupcích je jak jsem psal...máte na mysli rozmístění souborů ??

[elninoslov]

Kód: Vybrat vše

Sub Vyhladaj()  'Ak sa volá list na prehľadávanie vždy "Hárok1"
Dim Subor As String, R As Long
  Subor = "Z:\Vyhľadávanie v inom zošite\Zošit2.xlsx"
  If Len(Dir(Subor)) = 0 Then MsgBox ("Súbor neexistuje." & vbNewLine & Subor): Exit Sub
  Subor = "'" & WorksheetFunction.Replace(Subor, InStrRev(Subor, "\"), 1, "\[") & "]Hárok1'!"
  
  With ActiveSheet
    R = .Cells(Rows.Count, 11).End(xlUp).Row - 1
    If R > 0 Then
      With .Cells(2, 12).Resize(R)
        .Formula = "=IF(ISERROR(MATCH(K2," & Subor & "$L:$L,0)),"""",INDEX(" & Subor & "$A:$A,MATCH(K2," & Subor & "$L:$L,0)))"
        .Value2 = .Value2
      End With
    End If
  End With
End Sub

Kód: Vybrat vše

Sub Vyhladaj2() 'Ak je list na prehľadávanie vždy 1. v poradí (bez ohľadu na meno listu)
Dim Subor As String, R As Long, WSN As String
  Subor = "Z:\Vyhľadávanie v inom zošite\Zošit2.xlsx"
  If Len(Dir(Subor)) = 0 Then MsgBox ("Súbor neexistuje." & vbNewLine & Subor): Exit Sub
  
  Application.ScreenUpdating = False
  Workbooks.Open (Subor)
  With ActiveWorkbook
    WSN = .Worksheets(1).Name
    .Close False
  End With
  Application.ScreenUpdating = True
  
  Subor = "'" & WorksheetFunction.Replace(Subor, InStrRev(Subor, "\"), 1, "\[") & "]" & WSN & "'!"
  With ActiveSheet
    R = .Cells(Rows.Count, 11).End(xlUp).Row - 1
    If R > 0 Then
      With .Cells(2, 12).Resize(R)
        .Formula = "=IF(ISERROR(MATCH(K2," & Subor & "$L:$L,0)),"""",INDEX(" & Subor & "$A:$A,MATCH(K2," & Subor & "$L:$L,0)))"
        .Value2 = .Value2
      End With
    End If
  End With
End Sub

[Acce]

Děkuji moc, včera jsem byl pracovně pryč, takže jsem na to koukl až dnes...ve vzorovém sešitu vše fungovalo, v reálnym dokumentu ne, nakonec byl nejspíš problém ve formátu sešitu, celý sem zkopíroval a vytvořil nový soubor, po nepatrných úpravách vše funguje, jak jsem si představoval...Díky moc, opravdu si toho vážím...zastávám heslo: ''Když můžu tak pomůžu''..a jsem rád, že nejsem sám. Ještě jednou díky elninoslov