Makro - til at kopier udfra en given forudsætning

Hej kasp

Hermed lidt VBA-kode håber det er brugbart

Public sidste As Integer
Sub find()
start:
o = "Angiv tal til overførsel (1,2,3)"
titel = "Indtast tal"
std = 1
talværdi = 1
talværdi = InputBox(o, titel, std)

If talværdi = 1 Then
tal = 10001
ElseIf talværdi = 2 Then
tal = 20010
ElseIf talværdi = 3 Then
tal = 30030
Else: MsgBox ("du skal vælge 1, 2 eller 3")
GoTo start
End If

Application.Run "sidste_linie"

Sheets("Ovfdata").Select
Cells(1, 1).Select
For a = 1 To sidste
If ActiveCell = tal Then
Application.Run "overfør"
End If
ActiveCell.Offset(1, 0).Select
Next
End Sub

Sub sidste_linie()
celle = ActiveCell.Address
Range("a65000").Select
sidste = Selection.End(xlUp).Row
Range("b65000").Select
sidste1 = Selection.End(xlUp).Row
If sidste1 > sidste Then
sidste = sidste1
End If
Range(celle).Select
End Sub

Sub overfør()
    ActiveCell.EntireRow.Select
    Selection.Copy
    Sheets("GrundData").Select
    Cells(1, 1).Select
    ActiveCell.Select
    ActiveSheet.Paste
   
End Sub

Hvis dette virker efter dit ønske må det da min. være 30 point værd.

Hej jan-m.
Tak for dit svar. Jeg kan godt få makroen til at fungere (sådan da). Den går fint nok ind og søger, men returnere kun en linje i modtager arket "GrundData".

Jeg vil lige høre dig om jeg kan lokke dig til at indsætte nogle kommentar til koderne... jeg vil nemlig gerne lære noget VBA :-)

Hej kasp

Jeg kan godt tilføje nogle kommentarer.

Hvis du gerne vil have flere linier overført, er du nok nødt til at uddybe det lidt.

Mvh. Jan

Jeg har kortet jan-m's kodelidt ned

Sub find()
start:
    o = "Angiv tal til overførsel (1,2,3)"
    titel = "Indtast tal"
    std = 1
    talværdi = 1
    talværdi = InputBox(o, titel, std)
    If talværdi = 1 Then
        tal = 10001
    ElseIf talværdi = 2 Then
        tal = 20010
    ElseIf talværdi = 3 Then
        tal = 30030
    Else: MsgBox ("du skal vælge 1, 2 eller 3")
        GoTo start
    End If
    Sheets("Ovfdata").Select
    For a = 1 To Range("a65000").End(xlUp).Row
        If Cells(a, "A") = tal Then
      Rows(a).Copy Sheets("GrundData").Range("a65000").End(xlUp).Offset(1, 0)
        End If
    Next
End Sub

Fedt det virker. Mage tak.
kabbak. kan jeg lokke dig til at skrive en lille kommentar om hvad der sker. Bare så jeg kan lære noget til næste gang.
Hvem af jer skal jeg give pointene.
Mage tak for hjælpen

Hov lige et lille spørgsmål mere :-). Hvis arket "GrundData" er skjult virker makroen ikke. Kan man få den til det?

Giv point til Jan-m

Sub find()
start:
    o = "Angiv tal til overførsel (1,2,3)"
    titel = "Indtast tal"
    std = 1
    talværdi = 1
    talværdi = InputBox(o, titel, std)
   
    Select Case talværdi ' tjekker indtastningen
    Case 1
        tal = 10001
    Case 2
        tal = 20010
    Case 3
        tal = 30030
    Case Else
        MsgBox ("du skal vælge 1, 2 eller 3")
        GoTo start
    End Select

    Application.ScreenUpdating = False    ' Skærmens opdatering slås fra, for at undgå flimmer
    Sheets("GrundData").Visible = True    ' gør arket Grunddata synligt
    Sheets("Ovfdata").Select    ' vælger ark
    For a = 1 To Range("a65000").End(xlUp).Row    ' finder den sidste celle med værdier i a kolonnen
        If Cells(a, "A") = tal Then    ' tjekker om cellen indeholder tallet
            ' copierer rækken over i næste tomme celle i A kolonnen i arket GrundData
            Rows(a).Copy Sheets("GrundData").Range("a65000").End(xlUp).Offset(1, 0)
        End If
    Next
    Sheets("GrundData").Visible = False    ' gør arket Grunddata Usynligt
    Application.ScreenUpdating = True    ' Skærmens opdatering slås til igen
End Sub

Mange tak for hjælpen :-)

Jan-m. Smider du mig lige et svar så du kan få nogle point :-)

Hermed sendes et svar, det er iøvrigt fint lige at få koden "tunet" af én af de mere garvede, så jeg lærte skam også noget.

Her er nogle point :-)

hmm har jeg gjort det her forkert. syntes ikke der sker noget når jeg trykker Accepter?

jan-m har kun lagt kommentarer, han skal give et svar først.

Jeg undskylder fejlen og takker.