Hi all!
I have recently wrote a vba program, to search and paste the desired data to a table. The first sheet is a table with 4 inputs to be filled, while the other contains a pile of data.
My codes are able to figure out which data I want with reference to the inputs. However, the codes fail to select the range of data and paste them on the table (no response). The codes are shown below. Line, Track, Km1 and Km2 are the 4 inputs.
Sub Curve()
Dim RowFirst As Integer
Dim RowEnd As Integer
Line = Range("Line").Value
Track = Range("Track").Value
Km1 = Range("FromKm").Value
Km2 = Range("ToKm").Value
RowFirst = 0
RowEnd = 0
Sheets("Curve").Select
If Line = "K" And Track = "U" Then
Sheets("Curve").Range("E3").Select
F = 2
ElseIf Line = "K" And Track = "D" Then
Sheets("Curve").Range("E173").Select
F = 173
ElseIf Line = "TK" And Track = "U" Then
Sheets("Curve").Range("E331").Select
F = 331
ElseIf Line = "TK" And Track = "D" Then
Sheets("Curve").Range("E423").Select
F = 423
ElseIf Line = "TW" And Track = "U" Then
Sheets("Curve").Range("E501").Select
F = 501
ElseIf Line = "TW" And Track = "D" Then
Sheets("Curve").Range("E701").Select
F = 701
ElseIf Line = "I" And Track = "U" Then
Sheets("Curve").Range("E861").Select
F = 861
ElseIf Line = "I" And Track = "D" Then
Sheets("Curve").Range("E1028").Select
F = 1028
ElseIf Line = "TC" And Track = "U" Then
Sheets("Curve").Range("E1198").Select
F = 1198
ElseIf Line = "TC" And Track = "D" Then
Sheets("Curve").Range("E1344").Select
F = 1344
ElseIf Line = "A" And Track = "U" Then
Sheets("Curve").Range("E1486").Select
F = 1486
ElseIf Line = "A" And Track = "D" Then
Sheets("Curve").Range("E1656").Select
F = 1656
ElseIf Line = "D" And Track = "U" Then
Sheets("Curve").Range("E1840").Select
F = 1840
ElseIf Line = "D" And Track = "D" Then
Sheets("Curve").Range("E1866").Select
F = 1866
End If
Sheets("Curve").Select
ActiveCell.Offset(1, 0).Activate
Do While ActiveCell.Value < Km1
ActiveCell.Offset(1, 0).Activate
RowFirst = RowFirst + 1
If ActiveCell.Value >= Km1 Then
RowFirst = RowFirst + 1
Exit Do
End If
Loop
Sheets("Curve").Range("F" & F).Select
ActiveCell.Offset(1, 0).Activate
Do While ActiveCell.Value < Km2
ActiveCell.Offset(1, 0).Activate
RowEnd = RowEnd + 1
If ActiveCell.Value >= Km2 Then
RowEnd = RowEnd + 1
Exit Do
End If
Loop
Sheets("Curve").Select
ActiveSheet.Range(Cells(RowFirst + F, 3), Cells(RowEnd + F, 8)).Select
Selection.Copy
Sheets("Form").Select
Range("CurveID").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Bookmarks