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
299
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
- 1572507
Kun viimeksi kohtasitte/näitte
Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...1341935Olet kyllä vaarallisen himokas
Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.1061785- 721460
- 761398
Anna vielä vähän vihreää valoa
Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet211357- 2271100
- 71890
Miksi homous puhuttaa konservatiiveja vuodesta toiseen?
Kysymykseen on vastattukin Kansanlähetyksen osalta: "Miksi sukupuoleen ja seksuaalisuuteen liittyvät asiat ovat konserv220886- 54857