-
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
b3n1t0
#32365
üzenetére
A makrót modulba kell tenned.
Sorra veszi az A oszlop dátumait. Ha van azoknak megfelelő lap a füzetben, akkor annak az első üres sorába másol. Ha nincs létrehozza a lapot.
Mivel lapnévben nem szerepelhet a törtjel, helyette alsó kötőjelet ír. Az A oszlopban maradhat a törtjeles dátum, nem kell módosítanod.
Sub Kulon_Lapra()
Dim sor As Long, lapnev As String, a, hova As Long
sor = 1
Do While Cells(sor, 1) <> ""
lapnev = Cells(sor, "A")
lapnev = Left(lapnev, 2) & "_" & Mid(lapnev, 4, 2) & "_" & Right(lapnev, 2)
On Error Resume Next
Set a = Sheets(lapnev)
If Err.Number <> 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = lapnev
Sheets(1).Activate
End If
On Error GoTo 0
hova = Application.WorksheetFunction.CountA(Sheets(lapnev).Columns(1)) + 1
Rows(sor).Copy Sheets(lapnev).Cells(hova, 1)
sor = sor + 1
Loop
End Sub
Új hozzászólás Aktív témák
- Magisk
- Két 8 GB-os VGA-ra teszi fel ezt a negyedévet az NVIDIA?
- Arc Raiders
- Otthoni hálózat és internet megosztás
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- Ilyet se látunk minden nap, már füstölt a GeForce, de a játék még futott
- sziku69: Fűzzük össze a szavakat :)
- Hamarosan mobilokra is befut a Where Winds Meet
- Vezeték nélküli fülhallgatók
- További aktív témák...
- LicencAruhaz.hu OLCSÓ, LEGÁLIS SZOFTVEREK AZONNAL - Windows - Office - Win Server - ÖRÖK GARANCIÁVAL
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- MS SQL Server 2016, 2017, 2019
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- GYÖNYÖRŰ iPhone 14 128GB Midnight -1 ÉV GARANCIA - Kártyafüggetlen, MS3972
- ÁRGARANCIA!Épített KomPhone i9 14900KF 64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
- KÉSZLETKISÖPRÉSI KARÁCSONYI ULTRAAKCIÓ! - MacBook Air M4 16GB 512GB Garancia!
- Csere-Beszámítás! Xbox Series S 512GB! Számla + Garancia.
- Gamer PC-Számítógép! Csere-Beszámítás! I7 7700K / RTX 2080 / 16GB DDR4 / 480GB SSD
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs
Fferi50
