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
345
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
- 1382091
- 1211445
Atte Harjanne usuttaa eläkeläisvihaan
Karmeeta kuultavaa aamun uutislähetyksessä, kun Atte Harjanne, tunnettu eläkeläisvihaaja, suitsii sukupolvien välistä v3331223Postimerkki kirjeeseen ja kortiin maksaa jo 3 euroa!
https://yle.fi/a/74-20229241 Kyllä tämä on järjetön hinta, Posti tuhoaa itsensä tällä hinnalla, täytyyhän Postin "Herro1401180IS: Väitöstutkimus - Pyöräilybuumi oli pelkkä kupla!
Pyöräilybuumista paljastui karu totuus Väitöstutkimuksen mukaan suuri suomalainen pyöräilyrenessanssi olikin vain pelkk31151Keitä oli kunnanjohtajan erottajat?
Kouluja ei ole varaa ylläpitää mutta johtajasopimukseen palaa 100000 euroa ja uuden johtajan hakuprosessi maksaa kymmeni641150- 1411129
- 491089
Mene perheinesi arkkiin - kasteelle !
Juutalaiset oli hyvin lapsirakkaita, mitään ehkäisyä ei käytetty. Perheissä oli paljon lapsia. Viiden koko perheen kast470957Milloin bikineistä
Tuli juhla tai esiintymis asu? Pikkasen harkintaa vois käyttää. Bikinit kuuluvat uimarannalle. No, mitä maailman tähdet98955