data1 = {{1, 1.1}, {2, 1.5}, {3, 0.9}, {4, 2.3}, {5, 1.1}};
data2 = {{1, 1001.1}, {2, 1001.5}, {3, 1000.9}, {4, 1002.3}, {5, 1001.1}};
ListPlot[data1, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Red]
ListPlot[data2, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Blue]

Show[{
  ListPlot[data1, PlotRange -> {{1, 5}, {-100, All}}, Joined -> True, Mesh -> Full,
     PlotStyle -> Red, AxesOrigin -> {1, -50}],
  ListPlot[data2, Joined -> True, Mesh -> Full, PlotStyle -> Blue]
}]

snip[pos_] := Arrowheads[{{Automatic, pos,
     Graphics[{BezierCurve[{{0, -(1/2)}, {1/2, 0}, {-(1/2), 0}, {0, 1/2}}]}]}}];
getMaxPadding[p_List] := Map[Max, (BorderDimensions@
    Image[Show[#, LabelStyle -> White, Background -> White]] & /@ p)~Flatten~{{3}, {2}}, {2}] + 1
p1 = ListPlot[data1, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Red,
    AxesStyle -> {None, snip[1]}, PlotRangePadding -> None, ImagePadding -> 30];
p2 = ListPlot[data2, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Blue,
    Axes -> {False, True}, AxesStyle -> {None, snip[0]}, PlotRangePadding -> None, ImagePadding -> 30];

Column[{p2, p1} /. Graphics[x__] :>
    Graphics[x, ImagePadding -> getMaxPadding[{p1, p2}], ImageSize -> 400]]

data1 = {{1, 1.1}, {2, 1.5}, {3, 0.9}, {4, 2.3}, {5, 1.1}};
data2 = {{1, 1001.1}, {2, 1001.5}, {3, 1000.9}, {4, 1002.3}, {5, 1001.1}};

p = ListLinePlot[{data1, data2}, PlotRange -> All,
 PlotLabel -> "Example of a compressed y axis",
 AxesLabel -> {"x", "y"}];

compressYAxis[p, {0, 3}, {999, 1003}]

Clear[compressYAxis];
compressYAxis[plot_, range1_, range2_] :=
  Module[{ytick1, ytick2, epilog1, target},
   ytick1 = FindDivisions[range1, 5] /. y_?NumericQ :> {y, y} /. {y_?NumericQ, _} /; y >= range1[[2]] :> Sequence[];
   ytick2 = FindDivisions[range2, 5] /. y_?NumericQ :> {y - range2[[1]] + range1[[2]], y} /. {y_?NumericQ, _} /; y <= range1[[2]] :> Sequence[];
   epilog = Options[plot, Epilog][[1, 2]];
   target = Subtract @@ Reverse@range1/(Subtract @@ Reverse@range1 + Subtract @@ Reverse@range2);
   Show[plot /. {x_?NumericQ, y_?NumericQ /; y > range2[[1]]} :> {x, y - range2[[1]] + range1[[2]]},
     PlotRange -> {range1[[1]], range1[[2]] + Subtract @@ Reverse@range2},
     Ticks -> {Automatic, Join[ytick1, ytick2]},
     Epilog -> Join[epilog, {White, Rectangle[Scaled[{-0.1, 0.98 target}], Scaled[{1.1, 1.02 target}]], Black, Text[Rotate["\", [Pi]/2], Scaled[{0, 0.98 target}], {-1.5, 0}], Text[Rotate["\", [Pi]/2], Scaled[{0, 1.02 target}], {-1.5, 0}]}]]
 ]

ClearAll[sf, isf, inset]
sf[t1_, t2_, gap_: 1/10][x_] := Piecewise[{{x, x <= t1}, {t1 + gap/(t2 - t1) (x - t1),
    t1 <= x <= t2}, {t1 + gap + (x - t2), x >= t2}}]
isf[t1_, t2_, gap_: 1/10][x_] := InverseFunction[sf[t1, t2, gap]][x]
head = Graphics[{EdgeForm[None], FaceForm[White],
    Polygon[{{-1, -1/6}, {1, 5/6}, {1, 1/6}, {-1, -5/6}}], Black,
    CapForm["Butt"], AbsoluteThickness[1],
    Line[{{{-1, -5/6}, {1, 1/6}}, {{-1, -1/6}, {1, 5/6}}}]}];
inset[pos_: Scaled[{0.005, .55}], size_: {1/3, 1/3}] := Inset[head, pos, Automatic, size]


{t1, t2} = {Ceiling[#[[1, 2]]], Floor[#[[2, 1]]]} &@(CoordinateBounds[#][[2]]&/@ {data1, data2});
{yrange1, yrange2} = {Floor[#, .5], Ceiling[#2, .5]} & @@@
  (CoordinateBounds[#][[2]] & /@ {data1, data2});
ticks = Join[Charting`FindTicks[{0, 1}, {0, 1}][## & @@ yrange1],
   Charting`FindTicks[{0, 1}, {0, 1}][## & @@ yrange2]];

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}},
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False,
 Epilog -> inset[], ImageSize -> Medium, AspectRatio -> Automatic]

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}},
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False,
 ImageSize -> Medium, AspectRatio -> Automatic,
 AxesStyle -> {Automatic, Arrowheads[{{.03, .55, MapAt[
   {Antialiasing -> True, GeometricTransformation[#, RotationTransform[-Pi/2]]}&, head, {1}]}}]}]

ClearAll[snip2, inset2]
head2 = Graphics[{Antialiasing -> True, FaceForm[White],
   Rectangle[{-1/3, -1/2}, {2/3, 1/2}],
   {#, Translate[#, {1/2, 0}]} &@BezierCurve[{{0, -(1/2)}, {1/2, 0}, {-(1/2), 0}, {0, 1/2}}]}];
snip2[pos_] := Arrowheads[{{Automatic, pos, head2}}];
inset2[pos_: Scaled[{0.005, .55}], size_: {1/3, 1/3}] := Inset[
  MapAt[GeometricTransformation[#, RotationTransform[Pi/2]] &, head2, {1}], pos, Automatic, size]

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}},
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False,
 Epilog -> inset2[], ImageSize -> Medium, AspectRatio -> Automatic]

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}},
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False,
 AxesStyle -> {Automatic, snip2[.55]}, ImageSize -> Medium,
 AspectRatio -> Automatic]