kevike

Vapaa kuvaus

Aloituksia

5

Kommenttia

3

  1. Sain tehtyä tällaisen ratkaisun. Tässä kerätään Keraa_tanne tiedostoon Antti.xlsm, Katri.xlsm, Erkki.xlsm ja Mia.xlsm tiedostoista samanlainen alue. Ohjelma avaa yksitellen tiedostot ja vie alueen Keraa_tanne lehdelle allekkain jättäen yhden rivin väliin.

    Sub Keraa_Lomakkeet()
    Keraa_tanne = Application.ActiveWorkbook.Name
    'Olet Keraa_tanne tiedoston Nelja_sivua lehdellä
    ' Täällä on soluissa D5:D9 4 linkkiä. Ensimmäinen linkki esim. C:\Datat\Antti.xlsm
    For L = 1 To 4
    Range("D5").Select
    ActiveCell(L, 1).Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Sheets("Lomake").Select
    P_lomake = Application.ActiveWorkbook.Name
    Application.Workbooks(P_lomake).Activate
    If L = 1 Then
    Application.Workbooks(Keraa_tanne).Sheets("Nelja_sivua").Range("J3:P53") = _
    Sheets("Lomake").Range("D5:J55").Value
    ActiveWindow.Close
    ElseIf L = 2 Then
    Application.Workbooks(Keraa_tanne).Sheets("Nelja_sivua").Range("J55:P105") = _
    Sheets("Lomake").Range("D5:J55").Value
    ActiveWindow.Close
    ElseIf L = 3 Then
    Application.Workbooks(Keraa_tanne).Sheets("Nelja_sivua").Range("J107:P157") = _
    Sheets("Lomake").Range("D5:J55").Value
    ActiveWindow.Close
    ElseIf L = 4 Then
    Application.Workbooks(Keraa_tanne).Sheets("Nelja_sivua").Range("J159:P209") = _
    Sheets("Lomake").Range("D5:J55").Value
    ActiveWindow.Close
    End If
    Next L
    End Sub

    Linkin tekeminen löytyy Excelistä "Lisää" valikosta. Siellä on maapallo ja ketjun pala.
  2. Varokaa ostamasta. Itse "ostin" WinThruster ohjelman 27,18€. Sen jälkeen tuli viesti, että tuli ongelmia tilauksessa. Pyydettiin viemään ostostapahtuma loppuun. Hinta oli silloin jo n.40€. Hälytyskellot alkoivat soida. Katsoin tänään hintaa. Se oli nyt 22€ ja mukaan saisi Sweepe ohjelman. Mitähän hinta olisi, kun ostos ei "onnistu" eka kerralla?
  3. Kiitos ratkaisusta. Kokeilin laittaa tietoja soluihin E7-H7. Makro kopioi ne.
    Laitoin vielä A9 ja A10 jotain tekstiä, että "xlDown pelaa".
    Leikepöytä ei täyty nyt!

    Sub Makro1()
    ' Makro1 Makro
    Range("A9").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.Offset(0, 0).Range("A1:D1").Value = _
    Sheets("Taul1").Range("E7:H7").Value
    End Sub
    4. 1 / 1
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt