-
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
-
the radish
senior tag
válasz
Delila_1
#28550
üzenetére
Nem, de át is neveztem, nehogy bekavarjon.
Sajnos így sem megy.
Sub masolas()
Dim tol, ig
Dim WSI As Worksheet, WSM As Worksheet
Dim sorszam 'az A oszlop értékei
Dim sorM As Long 'ahova másolsz
Set WSI = Workbooks("A.xls").Sheets("Innen")
Set WSM = Workbooks("B.xls").Sheets("Ide")
WSI.Activate
Rows(1).copy WSM.Range("A1") 'fejléc másolása
sorszam = 1: tol = 2
Do While Cells(tol, 1) <> ""
'WSM.Cells = "" 'másolat lapjának kiürítése
sorM = Range("A2")
tol = Application.Match(sorszam, Columns(1), 0)
If VarType(tol) = vbError Then 'ha nem talált tol értéket
MsgBox "Kesz"
Exit Sub
Else
ig = Application.Match(sorszam, Columns(1), 1)
Rows(tol & ":" & ig).copy WSM.Range("A2")
proba 'Itt indul a saját makród
sorszam = sorszam + 1 'növeljük a keresendő értéket
End If
Loop
End Sub
Sub proba()
Range("A1:E3693").Select
Selection.copy
Windows("B.xls").Activate
Sheets("Munka2").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Sheets("ide").Select
MsgBox "Makró"
End SubPedig így tökéletes:
Sub masolas()
Dim tol, ig
Dim WSI As Worksheet, WSM As Worksheet
Dim sorszam 'az A oszlop értékei
Dim sorM As Long 'ahova másolsz
Set WSI = Workbooks("A.xls").Sheets("Innen")
Set WSM = Workbooks("B.xls").Sheets("Ide")
WSI.Activate
Rows(1).copy WSM.Range("A1") 'fejléc másolása
sorszam = 1: tol = 2
Do While Cells(tol, 1) <> ""
'WSM.Cells = "" 'másolat lapjának kiürítése
sorM = Range("A2")
tol = Application.Match(sorszam, Columns(1), 0)
If VarType(tol) = vbError Then 'ha nem talált tol értéket
MsgBox "Kesz"
Exit Sub
Else
ig = Application.Match(sorszam, Columns(1), 1)
Rows(tol & ":" & ig).copy WSM.Range("A2")
Makro 'Itt indul a saját makród
sorszam = sorszam + 1 'növeljük a keresendő értéket
End If
Loop
End Sub
Sub Makro() 'ez a saját makród
MsgBox "Makró"
End Sub
Új hozzászólás Aktív témák
- Úgy állhat le a 16 GB-os GeForce RTX 5060 Ti gyártása, hogy közben nem áll le
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Battlefield 6
- Milyen billentyűzetet vegyek?
- Apple iPhone 17 Pro Max – fennsík
- Amazfit Active 2 NFC - jó kör
- CES 2026: felcsavarta az AI-t az AMD, de örülhetnek a játékosok is
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Spórolós topik
- Okos Otthon / Smart Home
- További aktív témák...
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Antivírus szoftverek, VPN
- Most èrkezett pár darab RX ès RTX 8gb vga-k! Számlás garanciás! Kamatmentes rèszletre is!
- HIBÁTLAN APPLE WATCH ULTRA 2 NATURAL TITANIUM 49MM -1 ÉV GARANCIA - MS3713, 100% AKKUMULÁTOR
- BESZÁMÍTÁS! ASROCK B650M R7 7700 16GB DDR5 1TB SSD RTX 3070Ti 8GB ASUS TUF GT301 GIGABYTE 750W
- 187 - Lenovo LOQ (15IRX10) - Intel Core i7-13650HX, RTX 5070 (ELKELT)
- ÚJ Quansheng UV-K6 adóvevő eladó
Állásajánlatok
Cég: Laptopszaki Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Fferi50
