Hei Osaajat,
Valitettavasti itse en osaa tehdä tämmöistä makroa, joten käännyin teidän puoleen.
Eli haluan poistaa turhat rivit taulukosta ja sitten täydentää omilla asioilla. Eli alapuolella olisi jaoteltu näitä asioita.
1. Poistaa rivit, jos E kolumnissa ei ole tekstiä "kyllä"
2. Lisää uuden kolumnin A ja lisää A1 soluun tekstin "työnalla" jos b1 solussa on tekstiä… jatkaa tätä niin kauan kun B kolumnissa on tekstiä.
3. Kopioi rivin niin monta kertaa taul2 kun solussa kyseisen rivin D6 kolumnissa on luku. Eli solussa D6 on numero 6, niin kopioi rivin kuusi kertaa kyseisen rivin TAUL2. Sitten siirtyy D7 ja jos D7 on soluja 3, niin kopioi kyseisen rivin TAUL2 3 kertaa. Eli käy koko D kolumnin läpi.
4. Kysyy lopuksi mihin tiedosto tallennetaan.
Kiitos teille avusta.
Valitettavasti itse en osaa tehdä tämmöistä makroa, joten käännyin teidän puoleen.
Eli haluan poistaa turhat rivit taulukosta ja sitten täydentää omilla asioilla. Eli alapuolella olisi jaoteltu näitä asioita.
1. Poistaa rivit, jos E kolumnissa ei ole tekstiä "kyllä"
2. Lisää uuden kolumnin A ja lisää A1 soluun tekstin "työnalla" jos b1 solussa on tekstiä… jatkaa tätä niin kauan kun B kolumnissa on tekstiä.
3. Kopioi rivin niin monta kertaa taul2 kun solussa kyseisen rivin D6 kolumnissa on luku. Eli solussa D6 on numero 6, niin kopioi rivin kuusi kertaa kyseisen rivin TAUL2. Sitten siirtyy D7 ja jos D7 on soluja 3, niin kopioi kyseisen rivin TAUL2 3 kertaa. Eli käy koko D kolumnin läpi.
4. Kysyy lopuksi mihin tiedosto tallennetaan.
Kiitos teille avusta.
Vastaukset 2
Vanhimmat
Sub siivous()
Dim solu As Range
Columns("A").Insert
viimeinen = Cells.SpecialCells(xlCellTypeLastCell).Row
R = 1
R2 = 1
Do While R <= viimeinen
If Cells(R, "E").Value <> "kyllä" Then
Rows(R).Delete
viimeinen = viimeinen - 1
Else
If Cells(R, "B").Value <> "" Then Cells(R, "A") = "työnalla"
If WorksheetFunction.IsNumber(Cells(R, "D").Value) Then
For i = 1 To Cells(R, "D").Value
Sheets("Sheet2").Range(R2 & ":" & R2).Value = Range(R & ":" & R).Value
R2 = R2 1
Next i
End If
R = R 1
End If
Loop
UserForm1.Show
End Sub
UserForm1:een textbox ja nappi. Napin koodi:
Private Sub CommandButton1_Click()
ActiveWorkbook.SaveAs Filename:= TextBox1 _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
UserForm1.Hide
End Sub
Kiitos. Sain sen toimimaan.