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
- 561238
Pitkäaikaistyöttömyys Suomessa harvinaisen paha
Karut työttömyysluvut, korkein luku yli neljännesvuosisataan.1541202Mitä vastaisit
Jos kysyisin, että lähdettäisiinkö lenkille yhdessä? Vain sinä ja minä, kaksin? Miehelle601105Tiedän ettet tehnyt tahallasi pahaa
Asiat tapahtuivat, ristiriidat ovat meitä vahvempia. Olemmeko me niin vahvoja, että selviämme tästäkin vielä? Aika paljo1021054Janni Tikkanen ohjattiin miesten pukuhuoneeseen
Vai olisko sittenkin Janne Tikkanen? Jos siellä jalkojen välissä on miesten killukkeet, mieshän tämä Janni on. Ja kuuluu49990Rakastan 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ä56843Nyt 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ä55838Miten aiot saada kaivattusi?
1) loukuttamalla 2) kidnappaamalla 3) huijaamalla 4) jokin muu, mikä?54785- 32752
KIIKKUSTUOLI
Aloitetaan taas uudella alustalla, nuo pitkiksi venyneet ovat hankalia etsiä uusia viestejä, joskus vastauksia tulee sin73741