Onkohan yhteyksissäni häikkää, yritän lähettää tämn viestin jo kolmatta kertaa, toivottavasti nyt onnistuu...
Eli siis, tarvitsisin makron exceliin.
Lähdetään liikkeelle solusta AF1. Etsitään AF-sarakkeen viimeinen tietoja sisältävä solu.
Siitä solusta lähtien kopioidaan alue joka loppuu soluun AK1.
Tämän jälkeen kopioidaan myös alue A1:E8 siten, että molemmat alueet ovat kopioituina.
Onnistuuko?
Eli siis, tarvitsisin makron exceliin.
Lähdetään liikkeelle solusta AF1. Etsitään AF-sarakkeen viimeinen tietoja sisältävä solu.
Siitä solusta lähtien kopioidaan alue joka loppuu soluun AK1.
Tämän jälkeen kopioidaan myös alue A1:E8 siten, että molemmat alueet ovat kopioituina.
Onnistuuko?
Vastaukset 15
Vanhimmat
Onko sarakkeessa AF tyhjiä soluja, joiden alla on vielä kopioitavaa?
Mihin ne alueet pitäisi kopioida?
Pertti
Koodi valitsee alueet
Sub Alueet()
Dim vika As Double
Dim Alue1 As Range
Dim Alue2 As Range
vika = Range("AF65536").End(xlUp).Row
Set Alue1 = Range("AF" & vika & ":AK1")
Application.Union(Alue1, Range("A1:E8")).Select
End Sub
Kuvaus oli hieman epäselvä mutta eiköhän tällä pääse alkuun. Yleensä ottaen, ei kai leikepöydän kautta voi kopioida useita erillisiä laskentataulukon osia???
Sub Macro1()
Range("AF1").Activate
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
Range("AF" & ActiveCell.Row & ":AK1").Select
Selection.Copy
'Sitten paste minne palutaan, esim näin:
Range("AM1").Select
ActiveSheet.Paste
End Sub
No tehdään sitten loppuun asti...
Option Explicit
Sub Alueet()
Dim vika As Double
Dim Alue1 As Range
Dim Alue2 As Range
Dim Alueet() As Range
Dim KopioAlue As Range
Dim VasenYlä As Range
Dim Lukumäärä As Integer, i As Integer
Dim Ylärivi As Long, VasenSarake As Integer
Dim RiviSiirtymä As Long, SarakeSiirtymä As Integer
vika = Range("AF65536").End(xlUp).Row
Set Alue1 = Range("AF" & vika & ":AK1")
Application.Union(Alue1, Range("A1:E8")).Select
Lukumäärä = Selection.Areas.Count
ReDim Alueet(1 To Lukumäärä)
For i = 1 To Lukumäärä
Set Alueet(i) = Selection.Areas(i)
Next
Ylärivi = ActiveSheet.Rows.Count
VasenSarake = ActiveSheet.Columns.Count
For i = 1 To Lukumäärä
If Alueet(i).Row < Ylärivi Then
Ylärivi = Alueet(i).Row
End If
If Alueet(i).Column < VasenSarake Then
VasenSarake = Alueet(i).Column
End If
Next
Set VasenYlä = Cells(Ylärivi, VasenSarake)
Set KopioAlue = Range("A20")
For i = 1 To Lukumäärä
RiviSiirtymä = Alueet(i).Row - Ylärivi
SarakeSiirtymä = Alueet(i).Column - VasenSarake
Alueet(i).Copy KopioAlue.Offset(RiviSiirtymä, SarakeSiirtymä)
Next i
End Sub
Ajattelin lähinnä leikepöytää, jota tässä omassa makrossani käytetään. Muuttujilla voi varmasti tehdä vaikka minkälaisia temppuja - aika hienostihan tuo käy.
Mielestäni tämä allamainittu tekee vähemmillä riveillä sen minkä ongelmakuvauksesta ymmärsin. Makron päätyttyä tilanne on sellainen, että leikepöydällä on kopioituna nuo kaksi taulukkoa ja voidaan liittää minne ne nyt sitten ikinä halutaankaan.
Sub Macro1()
Dim vika As Double
Range("AF1").Activate
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
vika = ActiveCell.Row
Range("AF" & vika & ":AK1").Select
Selection.Copy
'Liitetään sitten A1:E8 alueen vierren
Range("F1").Select
ActiveSheet.Paste
'kopioidaan sitten nuo kaksi aluetta yhdessä
Range("A" & vika & ":K1").Select
Selection.Copy
End Sub
Entäpä jos AF sarakkeessa on vaikkapa 3 solussa dataa... silloin
Range("A" & vika & ":K1").Select
Selection.Copy
valitsee vain alueen A3:K1 ja jättää kopioimatta
rivit A4:E8 !!!
ja toinen puute tossa on se ,jos halutaan tosiaankin kopioida alueet samoilla offseteilla jonnekin muualle niin tässä se ei toimi
vähemmillä riveillä
Sub Macro1()
Dim vika As Double
Range("AF1").Activate
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
Range("AF" & ActiveCell.Row - 1 & ":AK1").Copy Range("F1")
Range("A" & ActiveCell.Row - 1 & ":K1").Copy
End Sub
sinunkaan versiosi tahdo toimia sen paremmin:
tulee Menetelmä "range" (objekti "_global") epäonnistui. Oiskos hyvä idea testata noi ennenkuin laittaa tänne !
Tapanani ei ole lähetellä testaamattomia versioita foorumeihin.Tekemäni versio toimii taatusti 2002 versiossa.Eriasia on sitten jos käytetään vanhempia versioita esim. 97.
Mitä kommentoin eipäs sinun koodiasi niin ei se toimi ohjeiden mukaisesti...
ei ollut minun koodiani,kunhan vain kokeilin tuota sinun koodiasi sekä WinMe XL97:ssa että W2K Pro XL2002:ssa ja kummassakaan se ei toimi.
Olet oikeassa mutta sama ongelma on kai sinunkin versiossa.
Mutta hei,lisätäänpä If-lause:
Sub Macro1()
Dim vika As Double
Range("AF1").Activate
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
vika = ActiveCell.Row
Range("AF" & vika & ":AK1").Select
Selection.Copy
'Liitetään sitten A1:E8 alueen vierren
Range("F1").Select
ActiveSheet.Paste
If (vika < 8) Then
vika = 8
End If
'kopioidaan sitten nuo kaksi aluetta yhdessä
Range("A" & vika & ":K1").Select
Selection.Copy
End Sub
Nyt pelittää ainakin tämä ohjelmassa Excel 2002
vika = Range("AF65536").End(xlUp).Row
Set Alue1 = Range("AF" & vika & ":AK1")
Tämä valitsee sarakkeessa AF viimeisen solun ja AK1 alueen.
Alkuperäisestä viestistä ei käynyt ilmi onko AF sarakkeessa mahdollisuutta olla myös tyhjiä soluja, elikä onko alue sarakkeessa yhtenäinen. Oma koodini hakee siis viimeisen käytetyn solun. Sinun koodisi hakee ensimmäisen tyhjän.
Jos muutetaan
vika = Range("AF1").End(xlDown).Row
niin hakee alueen ensimmäiseen tyhjään soluun asti(sama kuin sinun koodissasi)
Application.Union(Alue1, Range("A1:E8")).Select
Valitsee alueet alue1 (joka yllä haettiin dynaamisesti) ja A1:E8.
Onhan se vaikeata kuvitella mitä kukakin haluaa ja kun tässä foorumissa ei voi lähettää liitteitäkään niin ok.
Itse ajattelin,että halutaan valita 2 tiettyä aluetta AFXXX:AK1 ja A1:E8
Sun versiosi toimii ok,mutta ei vastaa sitä mitä ymmärsin lukiessa alkuehdot...
Jos halutaan nimenomaa valita ja(kopioida) A1:E8 ja toinen alue,niin korjausehdotuksesi ei siltikään poista sitä virhettä.
Odotellaan korjausehdotuksia!
Eli näin:
kopioi ns. dynaamisen alueen (AFXXXXX:AK1) ja liittää sen staattisen alueen (A1:E8) viereen),
jonka jälkeen makso kopioi nuo molemmat alueet yhdessä leikepöydälle ja tähän seis. Testauksessa toimii myös silloin jos sarakkeessa AF on vähemmän rivejä kuin 8.
Täytyy kai pyytää kohta tarkempia määrityksiä onkelmasta muutoin menee vaikeaksi arvailla ;)
"Täytyy kai pyytää kohta tarkempia määrityksiä onkelmasta muutoin menee vaikeaksi arvailla ;)
:)"
Joo toimiihan ne, mutta ei tiedetä miten pitäis toimia .)
Kiitos kovasti avustanne.
Tilanne on tämä.
Tekemästäni verkkokaupasta saapuu tilaus sähköpostiin. Se on huonosti muotoiltuna allekkain.
Kopioin tekstin ja liitän sen exceliin joka poimii tekstistä tiedot ja jäsentelee ja muotoilee tilauksen muotoon, jonka kelpaa lähettää tilauksen tekijälle tilausvahvistus/laskuna sähköpostilla.
Nyt jäsentelyn jälkeen tiedot ovat AF-sarakkeessa allekkain. Välissä on tyhjiä rivejä.
Alueessa A1:E8 on lasku, johon tiedot haetaan kaavoilla tilausteksteistä.
Tarkoitus olisi että saisin kopioitua tilausvahvistuksen sekä laskun, jotka liitetään sen jälkeen sähköpostiin ja lähetetään asiakkaalle.
Toivottavasti selkeytti asiaa...
Miten olisi tämä - laskutiedot ja tilaus tulostuvat allekkain alkaen rivilta 10. AF-sarakkeessa voi olla tyhjiä rivejä - tässä tietoa sisältäviä rivejä lähdetään nuuskimaan riviltä 100 ylöspäin (voipi muutta tarkoituksenmukaiseksi). Eikös tuosta saa nyt kopsattua tiedot vaikka minne?
Sub Macro1()
Range("A1:E8").Select
Selection.Copy
Range("A10").Activate
ActiveCell.Value = "TILAUSVAHVISTUS JA LASKU"
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Dim vika As Double
Range("AF100").Activate
Do While IsEmpty(ActiveCell.Value)
ActiveCell.Offset(-1, 0).Select
Loop
vika = ActiveCell.Row
Range("AF" & vika & ":AK1").Select
Selection.Copy
Range("A20").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub