- D1Rect: Nagy "hülyétkapokazapróktól" topik
- bambano: Bambanő háza tája
- Magga: PLEX: multimédia az egész lakásban
- Brogyi: CTEK akkumulátor töltő és másolatai
- Luck Dragon: Asszociációs játék. :)
- Elektromos rásegítésű kerékpárok
- gban: Ingyen kellene, de tegnapra
- Azonos árketegóriájú (105-110.000 Ft-os) relatív olcsó telefonok kamerái
- Pajac: tpm.msc
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
-
LOGOUT
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
-
Mutt
senior tag
válasz
wednesday #39417 üzenetére
Szia,
Itt van mutatott mintához a makró. A kommentek alapján tudod finomítani.
Sub Mentes()
Const urlap_helye = "Urlap" 'munkalap neve ahol van az űrlap
Const mentes_helye = "Mentes" 'munkalap neve ahova menteni kellene
Dim utolsoSor As Long, i As Long
Dim wsForras As Worksheet
Dim wsMentes As Worksheet
Set wsForras = ThisWorkbook.Sheets(urlap_helye)
Set wsMentes = ThisWorkbook.Sheets(mentes_helye)
With wsMentes
utolsoSor = .Range("A" & Rows.Count).End(xlUp).Row + 1 'megkeressük az első szabadsort a mentés lapon
For i = 17 To 35 'az űrlap 17-35 sora között nézzük a felírásokat
If Len(.Cells(i, "C")) > 0 Then
.Cells(utolsoSor, "A") = Now 'A-oszlopba rögzíjük a mentés dátumát
.Cells(utolsoSor, "B") = wsForras.Range("D7") 'B-oszlopba jön az első sorban lévő D-L egyesített cella tartalma
.Cells(utolsoSor, "C") = wsForras.Range("B" & i) 'C-oszlopba jön a B-oszlopbeli sorszám
.Cells(utolsoSor, "D") = wsForras.Range("C" & i) 'D-oszlopba a C-H tartalma
.Cells(utolsoSor, "E") = wsForras.Range("J" & i) 'E-oszlopba a J tartalma
.Cells(utolsoSor, "F") = wsForras.Range("K" & i) 'F-oszlopba a K tartalma
If .Cells(i, "C").MergeCells Then 'ha összevont cellákról van szó, akkor át kell ugornunk az összevont sorokat
i = i + .Cells(i, "C").MergeArea.Rows.Count - 1
End If
utolsoSor = utolsoSor + 1
End If
Next i
End With
Set wsForras = Nothing
Set wsMentes = Nothing
End Subüdv
-
lappy
őstag
Új hozzászólás Aktív témák
Hirdetés
- Eladó Steam kulcsok kedvező áron!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Assassin's Creed Shadows Collector's Edition PC
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- LG 48C2 - 48" OLED EVO - 4K 120Hz 1ms - NVIDIA G-Sync - FreeSync Premium - HDMI 2.1 - A9 Gen5 CPU
- Bomba ár! HP Elitebook Folio 9470M - i5-3GEN I 8GB I 256GB SSD I 14" I DP I Cam I W10 I Garancia!
- Csere-Beszámítás! AMD Ryzen 9 9900X Processzor!
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 32/64GB RAM RTX 5070Ti 16GB GAMER PC termékbeszámítással
- Törött, Hibás iPhone felvásárlás!!
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: CAMERA-PRO Hungary Kft
Város: Budapest