Lähtökohta: Työkirja 1 sisältää muutama kymmenen riviä, sarakkeet A:I. Osa riveistä ovat sellaisia, että sarakkeessa C on numero "1", osat ovat tyhjiä. Sarakkeessa B on kirjaimet välillä A-H.
Kaipaan koodin, joka (jos solussa B on A-kirjain ja solussa C "1") kopioi solut A ja I niiltä riveiltä -> liittää ne työkirjaan no. 2 alekkaisille riveille soluihin A ja B.
Vastaavasti jos solussa B on B-kirjain -> työkirjaan no. 3, solussa B C-kirjain -> työkirjaan no. 4 (kunhan vaan sarakkeessa C on "ykkönen") jne.
Olen hakannut päätäni seinään tuntikaupalla tämän kanssa, mutta ei vaan lähde. Kiitollinen kaikesta avusta. Excel 2003.
Kopioi osa soluista uuteen tk:aan, jos solussa C on "1"
Aurinko-Mooses
2
320
Vastaukset
Auttaskohan tuossa joka otsikkorivin lisäämin ja automaattisuodatuksen (tulee sarakekohtaiset valikot) käyttö ja (käsin) kopiointi tai sitten ns. tietokantafunktioiden käyttö?
varmaan tarkoitus on siirtää samassa työkirjassa TAULUKKOON 2,3 jne eikä TYÖKIRJAAN 2,3 jne
moduuliin...
Sub Siirrä()
Dim vika As Long
Dim solu As Range
Dim ws As Worksheet
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
If Not ws.Name = "Sheet1" Then
ws.Range("A:B") = ""
End If
Next
Worksheets("Sheet1").Activate
vika = Range("B65336").End(xlUp).Row
For Each solu In Range(("B1:B" & vika))
Select Case UCase(solu)
Case "A"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet2").Range("A65336").End(xlUp).Offset(1, 0)
End If
Case "B"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet3").Range("A65336").End(xlUp).Offset(1, 0)
End If
Case "C"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet4").Range("A65336").End(xlUp).Offset(1, 0)
End If
Case "D"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet5").Range("A65336").End(xlUp).Offset(1, 0)
End If
Case "E"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet6").Range("A65336").End(xlUp).Offset(1, 0)
End If
Case "F"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet7").Range("A65336").End(xlUp).Offset(1, 0)
End If
Case "G"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet8").Range("A65336").End(xlUp).Offset(1, 0)
End If
Case "H"
If solu.Offset(0, 1) = 1 Then
Union(solu, solu.Offset(0, 7)).Copy Worksheets("Sheet9").Range("A65336").End(xlUp).Offset(1, 0)
End If
End Select
Next
End Sub
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Janni Tikkanen ohjattiin miesten pukuhuoneeseen
Vai olisko sittenkin Janne Tikkanen? Jos siellä jalkojen välissä on miesten killukkeet, mieshän tämä Janni on. Ja kuuluu751738- 591698
Keskisarja loisti A-studiossa, vauhkoontunut Sofia Virta munasi itsensä
Keskisarja taas puhui 100% faktaa maahanmuuttoon liittyen. Kokoomuksen Kaumalta tuli pari hyvää puheenvuoroa, joskin muu3321439Pitkäaikaistyöttömyys Suomessa harvinaisen paha
Karut työttömyysluvut, korkein luku yli neljännesvuosisataan.1681419Mitä vastaisit
Jos kysyisin, että lähdettäisiinkö lenkille yhdessä? Vain sinä ja minä, kaksin? Miehelle671280Tiedän ettet tehnyt tahallasi pahaa
Asiat tapahtuivat, ristiriidat ovat meitä vahvempia. Olemmeko me niin vahvoja, että selviämme tästäkin vielä? Aika paljo1081259Rakastan ja ikävöin sinua
Ei helpota tämä ikävä millään. Pelkäsin että tämä ajanjakso tulee olemaan juuri näin vaikea. Siksi halusin ennen tätä pä621107- 601099
KIIKKUSTUOLI
Aloitetaan taas uudella alustalla, nuo pitkiksi venyneet ovat hankalia etsiä uusia viestejä, joskus vastauksia tulee sin971043Nyt tiistain galluppi alkaa....
Kuka on sun elämän rakkaus? Ketä kaipaat edelleenkin? Nyt nimiä vaan rohkeesti tuohon alle.Tää on ikäväpalsta, eikä mikä57980