-
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
- Okos Otthon / Smart Home
- sziku69: Fűzzük össze a szavakat :)
- Milyen routert?
- Kezdő fotósok digitális fényképei
- Semmibe veszi a KRESZ-t a Tesla Mad Max módja
- Milyen program, ami...?
- Trollok komolyan
- Elemlámpa, zseblámpa
- gban: Ingyen kellene, de tegnapra
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- További aktív témák...
- GYÖNYÖRŰ iPhone 13 Pro 256GB Graphite -1 ÉV GARANCIA - Kártyafüggetlen, MS3074, 100% Akkumulátor
- ÁRGARANCIA!Épített KomPhone i5 10400F 16/32/64GB RAM RX 7600 8GB GAMER PC termékbeszámítással
- Lenovo 14 Ideapad 3 FHD LED Matt i3-1115G4 4.1Ghz 8GB 256GB SSD Intel UHD Graphics Win11 Garancia
- REFURBISHED - DELL Performance Dock WD19DCS (210-AZBN)
- Azonnali készpénzes Microsoft XBOX Series S és Series X felvásárlás személyesen/csomagküldéssel
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
