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

Excelmarketing - Excel VBA makró blog - 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
    
    Mennyire találtad hasznosnak ezt cikket?
    [Összes szavazat: 7 Átlag értékelés: 4.1]