Bizonyos sorok másolása másik munkalapra makróval – Olvasói kérés #1

Új évi fogadalmam, hogy igyekszem többet foglalkozni a bloggal, és minden olvasói kérésre válaszolni, hiszen a különböző problémákból én is csak tanulok. 🙂

Szóval Iván azzal a kérdéssel fordult hozzám, hogyan lehet egyik munkalapról, a megjelölt sorokat átmásolni egy másik munkalapra. A megjelölés például az A oszlopban egy „x”-szel történik.

Tehát egy makró segítségével másoljuk át a „Munka1” lapon lévő azon sorokat „Munka2” lapra, amelyeknek az első oszlopában „x” szerepel.

1. Legegyszerűbb megoldás

A körülményeket nem ismerve, én biztos, hogy manuálisan állnék a feladathoz. Azaz „A” oszlopra ráteszek egy szűrőt, ahol az „x”-eket leszűröm, majd kijelölöm az így kapottakat és CTRL+C CTRL+V.

2. Makróval

Persze, gondolom nem véletlenül nem a fenti megoldásra esett a választás. Makróval is meg lehet oldani a feladatot, több módon is. Én a következő gondolatmenettel álltam neki:

Megnézzük, hány sorból áll a táblázatunk, ahol az adataink vannak. Jelen esetben nevezzük a „Munka1” lapnak. Tehát mi az utolsó sor, ahol adat van.

Megnézzük az oszlopok számát is.

Végigmegyünk a „Munka1” lapon, ahol az adataink vannak, az első oszlopon egy ciklussal. Fejlécet tartalmazunk, így a 2. sortól a korábban megállapított utolsó sorunkig.

Miközben végigmegyünk, megvizsgáljuk, hogy az éppen aktuális sor első oszlopában szerepel e „x”.

Ha igen, akkor az adott sor-t (jelen esetben az adott sor első oszlopától az utolsó oszlopáig) egyből át is másoljuk a „Munka2” lap első sorába.

Ha nincs x, akkor pedig a ciklusunk tovább halad.

Fontos, hogy ha átmásoltuk a Munka2-re az adott sorunkat, akkor ne feledjük el, hogy a sorok számához hozzá kell adni ott is egyet, hogy ne folyton az első sorba tegyen minden x-szel jelölt sor.

Sub Gomb1_Click()
'Meghatározzuk a "Munka1" lapon, hogy mi az utolsó sor és mi az utolsó oszlop, amiben van adatunk
'Ez azért kell, hogy rugalmas legyen a makrónk
    Dim utolso_sor As Long
    utolso_sor = Worksheets("Munka1").Cells(Rows.Count, "A").End(xlUp).Row

    Dim utolso_oszlop As Long
    utolso_oszlop = Worksheets("Munka1").Cells(1, Columns.Count).End(xlToLeft).Column
    
    MsgBox "Az utolsó oszlop száma: " & utolso_oszlop & vbNewLine & "Az utolsó sor száma: " & utolso_sor
 
'Meghatározzuk, hogy a "Munka2" lapon, mi az utolsó sor. Ide fogjuk bemásolni az "x"-szel jelölt sorokat a "Munka1"-ről
    Dim utolso_sorx As Long
    utolso_sorx = Worksheets("Munka2").Cells(Rows.Count, "A").End(xlUp).Row
    
    
'Végigmegyünk az 1. munklap A oszlopán, és megnézzük melyik sorokban van x, ha van x, akkor egyből át is másoljuk a "Munka2" lapra.
    For i = 2 To utolso_sor
        'Ha egyetzést találunk kimásoljuk
        If Worksheets("Munka1").Cells(i, 1).Value = "x" Then
            a = Worksheets("Munka1").Cells(i, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            b = Worksheets("Munka1").Cells(i, utolso_oszlop).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        
            'KIMÁSOLÁS
            Worksheets("Munka1").Range(a & ":" & b).Copy
                        
            'BEILLESZTÉS
            Worksheets("Munka2").Select
            ActiveSheet.Cells(utolso_sorx, 1).Select
            ActiveSheet.Paste
            
            'A Munka2 fülön mindig hozzáadunk egyet az adott sorhoz, így szépen egymás utáni sorokba másolja majd át az x-es sorokat.
            utolso_sorx = utolso_sorx + 1
        End If
    Next
End Sub