Hirdetés
-
PROHARDVER!
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
-
Árnymester
tag
Lehet nem a legelegánsabb megoldás...
Sub Szetszed()
Dim MyWs As Worksheet
Set MyWs = ActiveSheet
'Az első másolandó sor száma
r = 1
Do Until Not IsEmpty(MyWs.Cells(r, 1)) 'Ide olyan oszlopot adj meg, ami minden sorban tartalmaz adatot!
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
'Ide jönnek az oszlopok, a c1-c5-ök helyére a forrás(MyWs) értékes oszlopait kell beírni.
'Címsor másolása
ActiveSheet.Cells(1, 1).Value = MyWs.Cells(1, c1)
ActiveSheet.Cells(1, 2).Value = MyWs.Cells(1, c2)
ActiveSheet.Cells(1, 3).Value = MyWs.Cells(1, c3)
ActiveSheet.Cells(1, 4).Value = MyWs.Cells(1, c4)
ActiveSheet.Cells(1, 5).Value = MyWs.Cells(1, c5)
'Adatok másolása
ActiveSheet.Cells(1, 1).Value = MyWs.Cells(r, c1)
ActiveSheet.Cells(1, 2).Value = MyWs.Cells(r, c2)
ActiveSheet.Cells(1, 3).Value = MyWs.Cells(r, c3)
ActiveSheet.Cells(1, 4).Value = MyWs.Cells(r, c4)
ActiveSheet.Cells(1, 5).Value = MyWs.Cells(r, c5)
r = r + 1
Loop
End Sub
Új hozzászólás Aktív témák
- The Elder Scrolls Online Imperial Collector s Edition
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Microsoft és egyéb dobozos és OEM szoftverek
- Játékkulcsok olcsón: Steam, Uplay, GoG, EA, Xbox stb.
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- 2színben! Lenovo Yoga PRO 9 Ultra 9 285H 32GB RAM 2TB SSD RTX 5060 8GB 16" QHD+ OLED 3év Prémium GAR
- Microsoft: Windows / Office / Server / Stb.
- Gamer PC-Számítógép! Csere-Beszámítás! R5 3600X / GTX 1080Ti 11GB / 16GB DDR4 / 512 Nvme SSD
- Samsung Galaxy A21s 128GB, Kártyafüggetlen, 1 Év Garanciával
- ÁRGARANCIA!Épített KomPhone Ryzen 7 7800X3D 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
