Hirdetés
(használd a CYBSEC25PH kuponkódot további 20 ezer ft kedvezményért!)
-
Mobilarena
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
- Splinter Cell Blacklist the 5th Freedom Edition
- The Witcher 2 Assassins of Kings Collector's Edition
- Calman Home for LG licenc (PGenerator támogatással) ÚJ ára 66.000 Ft.
- AKCIÓ! Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával - Nint.hu
- Bioshock Infinite Ultimate Songbird Edition
- Gamer PC-Számítógép! Csere-Beszámítás! I7 6700 / Rog RX580 8GB / 32GB DDR4 / 500GB SSD
- Dell PA12 43NY4 65W utángyártott töltő
- Ravpower 6000 mAh-s mégis pici powerbank eladó
- HIBÁTLAN iPhone 13 mini 256GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS3440, 90% Akkumulátor
- HIBÁTLAN iPhone 13 Pro 128GB Silver -1 ÉV GARANCIA - Kártyafüggetlen, MS3666 100% Akkumulátor
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest