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.
Gyorskeresés
Legfrissebb anyagok
- Bemutató Spyra: akkus, nagynyomású, automata vízipuska
- Bemutató Route 66 Chicagotól Los Angelesig 2. rész
- Helyszíni riport Alfa Giulia Q-val a Balaton Park Circiut-en
- Bemutató A használt VGA piac kincsei - Július I
- Bemutató Bakancslista: Route 66 Chicagotól Los Angelesig
Általános témák
LOGOUT.hu témák
- [Re:] [D1Rect:] Nagy "hülyétkapokazapróktól" topik
- [Re:] [gban:] Ingyen kellene, de tegnapra
- [Re:] [Luck Dragon:] Asszociációs játék. :)
- [Re:] Gurulunk, WAZE?!
- [Re:] [sziku69:] Fűzzük össze a szavakat :)
- [Re:] [antikomcsi:] Való Világ: A piszkos 12 - VV12 - Való Világ 12
- [Re:] Spyra: akkus, nagynyomású, automata vízipuska
- [Re:] [sziku69:] Szólánc.
- [Re:] PLEX: multimédia az egész lakásban
- [Re:] [bitpork:] 2024 phautós tali ?
Szakmai témák
PROHARDVER! témák
Mobilarena témák
IT café témák
GAMEPOD.hu témák
Téma összefoglaló
- Utoljára frissítve: 2023-11-13 08:31:56
LOGOUT.hu
Hozzászólások
Delila_1
Topikgazda
3 makrót írtam. Az első sorra veszi a B oszlop celláit. Ha még nincs ennek megfelelő lap a füzetben, létrehozza, átmásolja a címsort és az aktuális sort. Az új lap neve az aktuális sor B oszlopában lévő adat lesz. Ha már van ilyen nevű lap, az első üres sorába másolja az aktuális sort. Nem kell az első lapon rendezettnek lennie a táblának.
A második sorra veszi a lapokat a másodiktól az utolsóig, Új füzetbe másolja az aktuális lapot, ezt elmenti a lapnév nevével az utvonal nevű változóban megadott mappába. Ezt a makró elején kell átírnod azutvonal = "C:\Temp\"
sorban a saját mentési útvonaladra.
Ha az eredeti füzetben nem akarod megtartani az újonnan létrehozott lapokat, akkor a második helyett a harmadik makrót futtasd. Ez nem másolja, hanem áthelyezi a lapokat 1-1 új füzetbe. Itt is át kell írnod az utvonal változó értékét.
A két másolós makró feltételezi, hogy kezdetkor 1 lap volt a füzetedben.
Sub Kulon_Lapra()
Dim sor As Long, lapnev As String, a, hova As Long, WS1 As Worksheet
Application.ScreenUpdating = False
Set WS1 = ActiveSheet
sor = 2
Do While Cells(sor, 1) <> ""
lapnev = Cells(sor, "B")
On Error Resume Next
Set a = Sheets(lapnev)
If Err.Number <> 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = lapnev
WS1.Rows(1).Copy Sheets(lapnev).Cells(1)
WS1.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
Application.ScreenUpdating = True
End Sub
Sub LapMentes()
Dim lap As Long, utvonal As String, lapnev As String
utvonal = "C:\Temp\"
Application.ScreenUpdating = False
For lap = 2 To Sheets.Count
lapnev = Sheets(lap).Name
Sheets(lapnev).Copy
ActiveWorkbook.SaveAs Filename:=utvonal & lapnev & ".xlsx"
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub
Sub MentTorol()
Dim lap As Long, utvonal As String, lapnev As String
utvonal = "C:\Temp\"
Application.ScreenUpdating = False
For lap = Sheets.Count To 2 Step -1
lapnev = Sheets(lap).Name
Sheets(lapnev).Move
ActiveWorkbook.SaveAs Filename:=utvonal & lapnev & ".xlsx"
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.