Alla olevan esimerkin Makro1, kopioi TAULUN A solut B1:B10 TAULUN B:n D1-sarakkeen soluihin B1:B10
Jos lisään TAULUUN A rivejä (B1 ja B10 väliin) esim 5 kpl pitäisi sama makro saada kopioimaan TAULUN A:n rivit B1:B15 TAULUUN B:n D1 solusta alkaen! Ei viitsisi aina muutella jos rivimäärä muuttuu!
Eli Range ("B1:B10").Select jälkimäisen arvon B10 pitäisi muuttua automaattisesti arvoon B15, jos TAULUN A:n rivimäärä kasvaa. RIVI komennoilla saan kyllä selville mm alueen lopun (B15), mutten saa sitä Range ("B1:B10").Select komentoon muutettua minun taidolla!
Etukäteen kiittäen Timo
Sub Makro1()
'
' Makro1 Makro
'
Sheets("Taulu_A").Select
Range ("B1:B10").Select
Selection.Copy
Sheets("Taulu_B").Select
Range ("D1").Select
ActiveSheet.Paste
End Sub
Haluaisiko joku auttaa Visual Bacic:n Makron kanssa, loppui osaaminen!
7
1239
Vastaukset 7
- Anonyymi
Lisää rivi joka tutkii sarakkeen B viimeisen tietoa sisältävän rivinumeron ja sitten valitse kopioita alue tilanteen mukaisesti:
Sub Makro1()
'
' Makro1 Makro
'
Sheets("Taulu_A").Select
LastRow = Range("B1").CurrentRegion.Rows.Count
Range("B1:B" & LastRow).Select
Selection.Copy
Sheets("Taulu_B").Select
Range("D1").Select
ActiveSheet.Paste
End SubPitää sen verran ottaa takaisin, toimii kyllä jos lisättyihin riveihin täyttää tietoa, mutta jos jäävät tyhjäksi kuten minun oikeassa taulukossa tapahtuu, ei kopioidu kuin siihen asti kuin tietoja on.
Pitäisi löytää sarakkeen viimeinen tietorivi vaikka välissä on tyhjiä soluja, koska tarve olisi tyhjentää makrolla taulunkon sarake esim riviltä 30 taulukon loppuun! (rivejä poistetaan ja lisätää, eikä kaikille tule aina tietoa)
Jaksatko vielä avitella?
Timo- Anonyymi
timidrikuukka kirjoitti:
Pitää sen verran ottaa takaisin, toimii kyllä jos lisättyihin riveihin täyttää tietoa, mutta jos jäävät tyhjäksi kuten minun oikeassa taulukossa tapahtuu, ei kopioidu kuin siihen asti kuin tietoja on.
Pitäisi löytää sarakkeen viimeinen tietorivi vaikka välissä on tyhjiä soluja, koska tarve olisi tyhjentää makrolla taulunkon sarake esim riviltä 30 taulukon loppuun! (rivejä poistetaan ja lisätää, eikä kaikille tule aina tietoa)
Jaksatko vielä avitella?
TimoSub Makro1()
'
' Makro1 Makro
'
Dim Alue As Range
Dim ViimeinenRivi As Integer
Dim Lkm As Integer
Sheets("Taulu_A").Select
Set Alue = Range("B:B")
ViimeinenRivi = 0
Lkm = WorksheetFunction.CountA(Alue)
Range("B1").Select
Do Until Lkm = 0
If ActiveCell.Value <> "" Then
Lkm = Lkm - 1
End If
ViimeinenRivi = ViimeinenRivi 1
ActiveCell.Offset(1, 0).Select
Loop
If ViimeinenRivi > 0 Then
Range("B1:B" & ViimeinenRivi).Select
Selection.Copy
Sheets("Taulu_B").Select
Range("D1").Select
ActiveSheet.Paste
End If
End Sub Anonyymi kirjoitti:
Sub Makro1()
'
' Makro1 Makro
'
Dim Alue As Range
Dim ViimeinenRivi As Integer
Dim Lkm As Integer
Sheets("Taulu_A").Select
Set Alue = Range("B:B")
ViimeinenRivi = 0
Lkm = WorksheetFunction.CountA(Alue)
Range("B1").Select
Do Until Lkm = 0
If ActiveCell.Value <> "" Then
Lkm = Lkm - 1
End If
ViimeinenRivi = ViimeinenRivi 1
ActiveCell.Offset(1, 0).Select
Loop
If ViimeinenRivi > 0 Then
Range("B1:B" & ViimeinenRivi).Select
Selection.Copy
Sheets("Taulu_B").Select
Range("D1").Select
ActiveSheet.Paste
End If
End SubKiitoksia uudelleen!
Näyttää että osaat homman, joten uskon että toimii tämäkin.
Ehdin jo ratkaista tyhjennysongelmani aiemmin lähettämälläsi ohjeella niin, että merkkasin yhteen sarakkeeseen jokaisen rivin kohdalle 1 ja sitä saraketta apuna käyttäen sain valittua tyhjennettävän alueen oikean kokoisena, pitää vain huolehtia 1 löytyminen sarakkeen jokaiselta riviltä.
Kun eläkekiireiltäni ehdin kirjoittelen makrot uudelleen tämän mukaan, niin kaikki hoituu paljon vaivattomammin.
Hyvää kevään jatkoa!
TimoAnonyymi kirjoitti:
Sub Makro1()
'
' Makro1 Makro
'
Dim Alue As Range
Dim ViimeinenRivi As Integer
Dim Lkm As Integer
Sheets("Taulu_A").Select
Set Alue = Range("B:B")
ViimeinenRivi = 0
Lkm = WorksheetFunction.CountA(Alue)
Range("B1").Select
Do Until Lkm = 0
If ActiveCell.Value <> "" Then
Lkm = Lkm - 1
End If
ViimeinenRivi = ViimeinenRivi 1
ActiveCell.Offset(1, 0).Select
Loop
If ViimeinenRivi > 0 Then
Range("B1:B" & ViimeinenRivi).Select
Selection.Copy
Sheets("Taulu_B").Select
Range("D1").Select
ActiveSheet.Paste
End If
End SubPiti testata heti, 10 toimii kuin unelma!
- Anonyymi
timidrikuukka kirjoitti:
Piti testata heti, 10 toimii kuin unelma!
Hyvä homma! Päivä päivältä valoisampaa kevättä kaikille VBA-makroilijoille ja muillekin!
On aina mukava huomata, kun esim. Exceliä käytetään muuhunkin kuin yleisimpiin laskutoimituksiin. 👍
Niin se on, kysyvä ei tieltä eksy. Hienosti toimii, kiitoksia oikein paljon
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Moottoripyöräonnettomuus
Mopomiitissä tapahtunut onnettomuus ja uutisointi. Ajoradan ylityksen vaarallisuudesta ei mitään uutisointia. Ei myöskää66829Ampuminen kylpylässä
Onko vornasen timbe käynyt hiukan kylpemässä vai mikä tämä ampumatapaus on kylpylässä? Tuntuu aika villi meno olevan naa23819- 160818
Jos oikeasti haluat mies
Tiedät mitä on tehtävä. Luotan, että etenet jos haluat. En voi tehdä enää mitään kun ei ole numeroasi.103779Uusi ruokapaikka
Tuleeko Haapavedelle uusi lounaspaikka ,haetaan kokkia? Uusi firma kyseessä27728Miten sinä voit?
Kysytkö kukaan sitä sinulta? Olen huomannut, että jos kohtaa empaattisen ihmisen ja hän kysyy noin, saattaa padot murtua93687Kerro minulle totuus
Minä haluan kuulla sen nyt. Kenen kanssa sinä olet nykyisin, ja miksi jätit minut? 🐒192660- 22602
- 61592
Hautakivien massapoisto aloitettu Härkökankaan vanhalla hautausmaalla kaikessa hiljaisuudessa!
Suomussalmen seurakunnan kirkkoneuvosto on tehnyt historiansa surullisimman päätöksen hautojen haltuunotosta ja raivauks37586VILLISIKALAUMA TULOSSA IISALMEEN
Yle: Poliisi varoittaa Iisalmen keskustaa lähestyvästä villisikalaumasta Poliisi on pyytänyt Pohjois-Savossa Iisalmessa40549On todella ikävää
Todella ikävää, että asiat ovat menneet tällaisiksi. Tämä ei ollut missään vaiheessa tarkoitukseni. Olen tehnyt virheit78500- 39475
- 57465
Useita poliisiautoja kunnantalolla
Maijojen kyydissä tuttuja naamoja ja nyt kannetaan arkistolaatikoita autoihin. Nyt se on alkanut. Pidätykset.11458sinulle....
Olen ymmärtänyt, ettei minua haluta enää takaisin. Mitään pahaa en koskaan halunnut sinulle. Ikävä että kuvittelit niin.75457Hei, voitko kuunnella
Voisitko auttaa minua selvittämään asioita? En halua ajaa sinua hulluuteen kanssani, en sitoa sinua, en esittää vaatimu111455- 73451
- 54438
Oletteko koskaan torjuneet kaivattuanne?
Minä olen, kun en silloin tajunnut vielä ihastuneeni. Yritin paikata tapahtunutta, mutta ei onnistunut enää.25437