Egy oszlopból "n"-edik számú szó másolása "n"-edik munkalapra

Kedves Szilvi!

A feladat nem csak makróval oldható meg, de mielőtt erre rátérnék…

294 munkalap? Ez nem hangzik túl jól!
Kíváncsi lennék, hogy mi is a feladat igazából, mert arra gyanakszom, hogy ezzel csak további sok, fáradtságos manuális munka lesz, vagy szét kell makrózni. Na nem okoskodok tovább, lássuk a medvét!

Tegyük fel, hogy az első munkalapodat úgy hívják, hogy „Nevek”
Ebben az A1 a fejléc, utána A2-tól A293-ig vannak a nevek, B oszlopban a kódok.

A Nevek lap után jönnek sorban az egyes nevekhez tartozó individuális munkalapok, 293 db. (Jesszus !)
Példaként vegyünk csak ötöt!

1. Jelöld ki ezt az 5 munkalapot (Ctrl lenyomása mellett meg tudod csinálni.
Ezzel csoport módba lépsz, amit csinálsz, az minden munkalapon megtörténik.
2. kattints a B3-as cellába
3. Írde be, hogy =INDIREKT(„Nevek!A”&LAP())
4. Jobb klikk bármely csoportba fogott lapon -> Csoport szétbontása

Az egyes lapokon ott lesznek a nevek az első munkalapról.- MAGIC ! 🙂

Működése
A LAP() függvény argumentum nélkül kiadja az aktuális lap sorszámát. A Nevek az első lapod, utána a többi sorban a 2, 3, 4, 5, …
Az INDIREKT függvény szövegesen megadott hivatkozást valódi hivatkozássá tesz.
A második lapon a LAP() fv 2-t ad
A „Nevek!A”&LAP() pedig azt, hogy „Nevek!A2”, és az INDIREKT ezt a cellát címzi, és kiveszi belőle a nevet.
Mivel a LAP() fv minden lapon mást ad, egyesével nő, úgy jönnek a nevel egymás után a lapokn az A oszlpból.

A B oszloppal megtehető ugyanez.

Szólj, hogy sikerült-e.

De továbbra is szkeptikus vagyok, hogy valóban ezt akarjátok-e, ezért én a helyedben feltenném ide a valós feladatot is, mert itt az elején még időben vagyunk, hogy ne legyen tervezési probléma miatt használhatatlanul bonyolult a megoldás.

Van egy régi makróm, ami tartalomjegyzéket készít a lapokról, ahol a lapnevek linkek, a megfelelő lap A1 cellájára ugranak.
Mód van rá, hogy egyúttal minden lapra tegyen egy linket, amivel a tartalomjegyzék lapjára ugrorhatsz vissza.

Magyarázatokkal együtt küldöm a makrót.

Sub Tartalomjegyzek()
    'A makró egy tetszőleges nevű munkalapot szúr be a meglévőek elé.
    'Erre a munkalapra egy tartalomjegyzéket készít a többi munkalapot listázva,
    'hivatkozást is elhelyezve, amik az egyes munkalapok egy megadott cellájára mutatnak.
    'A lapokra vissza logikájú linket helyez el kérésre, egy megadott cellába.
    
    Dim TartalomLapnev As String, VisszaSzovege As String, VisszaHelye As String
    Dim aktiv As Integer, Vissza As Integer
    
    'Megkérdezi a felhasználótól, mi legyen a tartalomjegyzék munkalapjának a neve
    TartalomLapnev = InputBox("Mi legyen a tartalomjegyzék munkalapjának neve?", "Tartalomjegyzék munkalapjának neve")
    
    'Megkérdezi, szeretnénk-e vissza gombot elhelyezni a munkalapokon?
    Vissza = MsgBox("Legyen-e egy vissza logikájú link a munkalapokon?", 4, "Vissza logikájú link")
    
    'Ha igen, kérdezze meg, mi legyen a szöveg? pl. Alt+0171:«
    'és hol legyen az egyes lapokon
    If Vissza = 6 Then
        VisszaHelye = InputBox("Hova kerüljön a vissza logikájú link a lapokon?" & vbLf & "Pl.: A1", "Vissza logikájú link helye")
        VisszaSzovege = InputBox("Mi legyen a vissza logikájú link felirata?" & vbLf & "Pl. « (bal Alt+0171)", "Vissza logikájú link felirata")
    End If
    
    'Szúrjon be egy új munkalapot a meglévők elé a legelső helyre.
    ActiveWorkbook.Sheets.Add Before:=Worksheets(1)
    
    'Adja az új munkalapnak a felhasználó által megadott nevet
    Worksheets(1).Name = TartalomLapnev
    
    'Menjen végig a munkalapokon ...
    For aktiv = 2 To ActiveWorkbook.Sheets.Count
        '... és írja ezeknek a nevét sorszámmal ellátva az újonnan létrehozott lapra.
        Worksheets(1).Cells(aktiv, 1).Value = aktiv - 1 'sorszám
        Worksheets(1).Cells(aktiv, 2).Value = Worksheets(aktiv).Name    'lapnév
     
        'A munkalapok neveit tegye linkké
        With Worksheets(1)  'itt adhatjuk meg, hogy az egyes lapokon melyik cellára mutasson a link
            .Hyperlinks.Add Anchor:=.Cells(aktiv, 2), Address:="", _
                SubAddress:="'" & Worksheets(aktiv).Name & "'!A1", TextToDisplay:=Worksheets(aktiv).Name
        End With
        
        'Ha kértünk Vissza linket, hozza létre a vissza logikájú linket a megadott cellába
        If Vissza = 6 Then
            Worksheets(aktiv).Range(VisszaHelye).Value = VisszaSzovege
            With Worksheets(aktiv) 'itt adhatjuk meg, hogy a Vissza link melyik cellára álljon az első lapon
                .Hyperlinks.Add Anchor:=.Range(VisszaHelye), Address:="", _
                    SubAddress:="'" & TartalomLapnev & "'!B2", TextToDisplay:=VisszaSzovege
                .Range(VisszaHelye).Font.Bold = True
            End With
        End If
    Next aktiv
End Sub