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
316
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
Useita puukotettu Tampereella
Mikäs homma tämä nyt taas on? "Useaa henkilöä on puukotettu Tampereen keskustassa kauppakeskus Ratinan lähistöllä." ht2204219Kuka rääkkää eläimiä Puolangalla?
Poliisi ampui toistakymmentä nälkiintynyttä eläintä Puolangalla Tilalta oli ollut karkuteillä lähes viisikymmentä nälkii692715Asiakas iski kaupassa varastelua tehneen kanveesiin.
https://www.iltalehti.fi/kotimaa/a/33a85463-e4d5-45ed-8014-db51fe8079ec Oikein. Näin sitä pitää. Kyllä kaupoissa valtava3932411- 472343
Meneeköhän sulla
oikeasti pinnan alla yhtä huonosti kuin mulla? Tai yhtä huonosti mutta jollain eri tyylillä? Ei olisi pitänyt jättää sua381597Muutama kysymys ja huomio hindulaisesta kulttuurista.
Vedakirjoituksia pidetään historiallisina teksteinä, ei siis "julistuksena" kuten esimerkiksi Raamattua, vaan kuten koul5321350- 571320
Jos ei tiedä mitä toisesta haluaa
Älä missään nimessä anna mitään merkkejä kiinnostuksesta. Ole haluamatta mitään. Täytyy ajatella toistakin. Ei kukaan em951316- 761291
Jumala puhui minulle
Hän kertoi sinusta asioita, joiden takia jaksan, uskon ja luotan. Hän kuvaili sinua minulle ja pakahduin onnesta kuulles1251186