-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Fferi50
Topikgazda
válasz
föccer
#35863
üzenetére
Szia!
Ezt a makrót is megpróbálhatod:
Sub masol()
Dim rrange As Range
Set rrange = Range(Range("A22"), Cells(Range("A22").End(xlDown).Row, Range("A22").End(xlToRight).Column)).SpecialCells(xlCellTypeVisible) ' a szűrés után látható cellák
If rrange.Areas.Count = 1 Then 'ha egybefüggő a tartomány
Set rrange = rrange.Rows(2) 'a második sor kell nekünk
Else
If rrange.Areas(1).Rows.Count >= 2 Then 'ha az első terület legalább 2 sorból áll
Set rrange = rrange.Areas(1).Rows(2) 'a második sora kell nekünk
Else
Set rrange = rrange.Areas(2).Rows(1) 'az első terület egy sorból állt, ezért a második terület első sora kell nekünk
End If
End If
With Rows(18) ' a 18. sorba átírjuk az értékeket.
.Cells(1).Value = rrange.Cells(1).Value
.Cells(5).Value = rrange.Cells(5).Value
Range(.Cells(1, "o"), .Cells(1, "x")).Value = Range(rrange.Cells(1, "o"), rrange.Cells(1, "x")).Value
End With
End SubEz akkor működik hibátlanul, ha a szűrősorodban és az adattábládban mindenütt van adat, a tartomány végéig, nincsenek üres cellák közben.
Üdv.
Új hozzászólás Aktív témák
- Okos otthon - Home Assistant, openHAB és más nyílt rendszerek
- OLED monitor topic
- Hobby elektronika
- Eddigi legerősebb csatamágusát dobta piacra az Intel
- Trollok komolyan
- Székesfehérvár és környéke adok-veszek-beszélgetek
- Kerékpárosok, bringások ide!
- EA Sports WRC '23
- Törölte az idei asztali csúcsprocesszorát az Intel
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- További aktív témák...
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- GYÖNYÖRŰ iPhone 11 Pro 64GB Silver -1 ÉV GARANCIA - Kártyafüggetlen, MS3565
- Új DELL Inspiron 14 (5435)/AMD RYZEN 7-7730U/16GB/512 SSD/14"/FHD/IPS/Garancia
- 216 - Lenovo Legion Slim 7 (16IRH8) - Intel Core i7-13700H, RTX 4060 (ELKELT)
- iPhone 13 mini 128GB 100% (1év Garancia)- ÚJ EREDETI AKKUMULÁTOR
- Wacom Bamboo One CTF-430 rajztábla
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50