Olisiko jollain aikaa auttaa tähän seuraavaan ongelmaan. Minulla on excel taulukko jossa on siellä täällä boldattu numero ja sen alla n. kolme-neljä riviä selkokielistä tekstiä mitkä pitäisi saada kopioitua omaan soluun.
Sain tehtyä jo sellaisen makron joka hakee tuon boldaus numeron mutta mitä ihmettä siihen pitää laittaa että hakisi aina löytettyään ne neljä muuta riviä alaspäin?
Jo tehty makro on tälläinen:
______________________________>
Sub osoitteet()
Dim i As Long, LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Range("A" & i).Font.Bold = True Then
Range("A" & i).Copy Destination:=Range("K" & Range("K" & Rows.Count).End(xlUp).Offset(1, 0).Row)
End If
Next i
End Sub
Sain tehtyä jo sellaisen makron joka hakee tuon boldaus numeron mutta mitä ihmettä siihen pitää laittaa että hakisi aina löytettyään ne neljä muuta riviä alaspäin?
Jo tehty makro on tälläinen:
______________________________>
Sub osoitteet()
Dim i As Long, LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Range("A" & i).Font.Bold = True Then
Range("A" & i).Copy Destination:=Range("K" & Range("K" & Rows.Count).End(xlUp).Offset(1, 0).Row)
End If
Next i
End Sub
Vastaukset 1
Vanhimmat
Sub osoitteet()
Dim lngRC As Long, lngLR As Long
Const cstrCOL_DAT As String = "A"
Const cstrCOL_TAR As String = "K"
lngLR = Range(cstrCOL_DAT & Rows.Count).End(xlUp).Row
For lngRC = 1 To lngLR
If Range(cstrCOL_DAT & lngRC).Font.Bold = True Then
Range(cstrCOL_DAT & lngRC).Resize(5, 1).Copy Destination:=Range(cstrCOL_TAR & Range(cstrCOL_TAR & Rows.Count).End(xlUp).Offset(1, 0).Row)
lngRC = lngRC 4
End If
Next lngRC
End Sub