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
-
m.zmrzlina
senior tag
válasz
repvez #45415 üzenetére
Tegyük fel, hogy
-H2:H7 tartományban viszel fel adatokat a Munka1 nevű munkalapon
-ENTER-re lefelé ugrik az aktív cella és nem jobbra
-ha nem is írsz minden cellába a H2:H7-be akkor is leviszed az aktív cellát H8-ig
-további ha-k >....< ide
akkor itt egy Móricka megoldás:Private Sub Worksheet_Change(ByVal Target As Range)
Dim holavege As Long
Dim cella As Range
If ActiveCell.Column = 8 And ActiveCell.Row = 8 Then
holavege = Worksheets("Munka2").Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("Munka2").Range("A" & holavege) = Date
For Each cella In ActiveSheet.Range("H2:H7")
Worksheets("Munka2").Cells(holavege, cella.Row) = Worksheets("Munka1").Cells(cella.Row, 8)
Next
End If
End Sub
Ez azért Móricka megoldás mert csinál olyan dolgokat is amit nem szeretnél, de pontosabb megoldáshoz nekem pontosabb feladat leírás kellene. -
Fferi50
Topikgazda
válasz
repvez #45415 üzenetére
Szia!
Próbáld ki ezt az eseménykezelő makrót, a Munka1 munkalapod kódlapjára kell bemásolni.Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Variant
If Target.Address = "$H$2" Then
With Sheets("Munka2")
cel = Application.Match(CLng(Date), .Range("A:A"), 0)
If IsError(cel) Then
cel = .Range("A1000").End(xlUp).Row + 1
.Cells(cel, 1).Value = Date: .Cells(cel, 2).Value = Target.Value
Else
.Cells(cel, 1).End(xlToRight).Offset(0, 1).Value = Target.Value
End If
End With
End If
End SubÜdv.
Új hozzászólás Aktív témák
- World of Tanks - MMO
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Mozilla Firefox
- Luck Dragon: Asszociációs játék. :)
- Háztartási gépek
- Autós topik
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Hálózati / IP kamera
- AMD Ryzen 9 / 7 / 5 / 3 5***(X) "Zen 3" (AM4)
- Motorolaj, hajtóműolaj, hűtőfolyadék, adalékok és szűrők topikja
- További aktív témák...
- Game Pass Ultimate előfizetések 4 - 19 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Eladó Steam kulcsok kedvező áron!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- 145 - Lenovo Legion Pro 7 (16IRX9H) - Intel Core i9-14900HX, RTX 4090
- BESZÁMÍTÁS! Asus B550M R9 5900X 32GB DDR4 1TB SSD RTX 4070 SUPER 12GB Be Quiet! Silent Base 601 850W
- DELL PowerEdge R730xd 26SFF rack szerver - 2xE5-2680v3 (24c/48t, 2.5/3.3GHz), 64GB RAM, 10G, H730p
- Apple MacBook Air 13 2017 A1466 512Gb SSD / i7 / 8GB RAM / 12 hó jótállás
- PS Plus előfizetések
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft.
Város: Budapest