Új hozzászólás Aktív témák

• #35079 poffsoft veterán logitechh #35063

  Új Válasz 2017-05-02 10:33:28 #35079

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  poffsoft

  veterán

  válasz logitechh #35063 üzenetére

  Sub beillesztes()
'
' előre másik munkalapból kimásolt 4 oszlop szélességü tartományt beilleszt a B oszlop első üres sorától kezdve a B oszloptól az E oszlopig majd az A oszlopot kitölti sorszámmal illetve az F oszloptól az L oszlopig az F2:L2 tartomány képleteit másolja be addig a sorig ameddig a B oszlop tartalmaz elemet
'

Dim Asor As Long
Dim Bsor As Long
Dim i As Integer

Asor = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("B" & Asor).PasteSpecial xlPasteValues

Bsor = Range("B" & Rows.Count).End(xlUp).Row

Range("F2:L2").Copy Destination:=Range("F" & Asor & ":F" & Bsor ) 'a végén a -1 azt jelzi hogy nem az utlsó kitöltött sor plusz egy sorba másolja a képletet hanem csak az utolsó sorig

For i = Asor To Bsor 'számláló rész a Bsor esetén plusz egy sort beszámoz viszont ha csak a kitöltött celláig akarunk számozni akkor a-1 kell
Range("A" & i) = Range("A" & i - 1) + 1
Next i

'innen kezdődik a keretezés
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End Sub

Új hozzászólás Aktív témák