-
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
-
Delila_1
veterán
válasz
PerezT
#35996
üzenetére
3 helyen, a csillagozott sorokban kell módosítanod a makrót.
Nálam Munka1 a kiinduló lap neve, és Munka2, ahova átrendezve bemásolja az értékeket.A sorIde = 1: oszlopIde = 1 változók értékei adják meg, hogy a 2. lapon hol kezdődjön a tábla, ami itt az A1-es cella sora, és oszlopa.
Sub transz()
Dim sor As Long, usor As Long, sorIde As Long
Dim oszlop As Integer, uoszlop As Integer, oszlopIde As Integer
Sheets("Munka1").Select '***
uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
usor = Range("A" & Rows.Count).End(xlUp).Row
sorIde = 1: oszlopIde = 1 '***
With Sheets("Munka2") '***
For oszlop = 2 To uoszlop
For sor = 2 To usor
.Cells(sorIde, oszlopIde) = Cells(1, oszlop)
If Cells(sor, oszlop) > "" Then
.Cells(sorIde, oszlopIde + 1) = Cells(sor, 1)
.Cells(sorIde, oszlopIde + 2) = Cells(sor, oszlop)
sorIde = sorIde + 1
End If
Next
Next
End With
End Sub
Új hozzászólás Aktív témák
- Mibe tegyem a megtakarításaimat?
- Folyószámla, bankszámla, bankváltás, külföldi kártyahasználat
- Építő/felújító topik
- Épített vízhűtés (nem kompakt) topic
- Debrecen és környéke adok-veszek-beszélgetek
- Google Pixel Watch 3 - képpontos idő
- Milyen monitort vegyek?
- Android alkalmazások - szoftver kibeszélő topik
- Adatmentés - HDD - SSD - Flash
- Autós topik
- További aktív témák...
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Lenovo ThinkPad T14s Gen 6 Ryzen AI 7 PRO 350W Radeon 860M 32 GB RAM 7500 MT/s 512 GB 3év gar
- Apple iMac 27" 5K 2015 Late / 16GB DDR3 / 512 GB SSD / Bill+Egér 6 hó garancia, számlával!
- Eladó új állapotban levő Realme 8 Pro 8/128GB fekete / 12 hónap jótállás
- AZONNALI SZÁLLÍTÁS Eredeti Microsoft Office 2019 Professional Plus
- Dell Precision 3571 i7-12700H 16GB 512GB FHD RTX T600 4GB 1 év teljeskörű garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50