diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 88ecbacd3..b650721b3 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -122,18 +122,18 @@ attrFromBlockAttributes (BlockAttributes{..}) =
     kv      = filter ((`notElem` ["id", "class"]) . fst) blockAttrKeyValues
   in (ident, classes, kv)
 
-stringyMetaAttribute :: Monad m => (String -> Bool) -> OrgParser m (String, String)
-stringyMetaAttribute attrCheck = try $ do
+stringyMetaAttribute :: Monad m => OrgParser m (String, String)
+stringyMetaAttribute = try $ do
   metaLineStart
   attrName <- map toUpper <$> many1Till nonspaceChar (char ':')
-  guard $ attrCheck attrName
   skipSpaces
-  attrValue <- anyLine
+  attrValue <- anyLine <|> ("" <$ newline)
   return (attrName, attrValue)
 
 blockAttributes :: PandocMonad m => OrgParser m BlockAttributes
 blockAttributes = try $ do
-  kv <- many (stringyMetaAttribute attrCheck)
+  kv <- many stringyMetaAttribute
+  guard $ all (attrCheck . fst) kv
   let caption = foldl' (appendValues "CAPTION") Nothing kv
   let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv
   let name    = lookup "NAME" kv
@@ -150,13 +150,7 @@ blockAttributes = try $ do
            }
  where
    attrCheck :: String -> Bool
-   attrCheck attr =
-     case attr of
-       "NAME"      -> True
-       "LABEL"     -> True
-       "CAPTION"   -> True
-       "ATTR_HTML" -> True
-       _           -> False
+   attrCheck x = x `elem` ["NAME", "LABEL", "CAPTION", "ATTR_HTML", "RESULTS"]
 
    appendValues :: String -> Maybe String -> (String, String) -> Maybe String
    appendValues attrName accValue (key, value) =
@@ -166,6 +160,7 @@ blockAttributes = try $ do
             Just acc -> Just $ acc ++ ' ':value
             Nothing  -> Just value
 
+-- | Parse key-value pairs for HTML attributes
 keyValues :: Monad m => OrgParser m [(String, String)]
 keyValues = try $
   manyTill ((,) <$> key <*> value) newline
@@ -301,16 +296,15 @@ codeBlock blockAttrs blockType = do
   skipSpaces
   (classes, kv)     <- codeHeaderArgs <|> (mempty <$ ignHeaders)
   content           <- rawBlockContent blockType
-  resultsContent    <- trailingResultsBlock
+  resultsContent    <- option mempty babelResultsBlock
   let id'            = fromMaybe mempty $ blockAttrName blockAttrs
   let codeBlck       = B.codeBlockWith ( id', classes, kv ) content
   let labelledBlck   = maybe (pure codeBlck)
                              (labelDiv codeBlck)
                              (blockAttrCaption blockAttrs)
-  let resultBlck     = fromMaybe mempty resultsContent
   return $
-    (if exportsCode kv    then labelledBlck else mempty) <>
-    (if exportsResults kv then resultBlck   else mempty)
+    (if exportsCode kv    then labelledBlck   else mempty) <>
+    (if exportsResults kv then resultsContent else mempty)
  where
    labelDiv :: Blocks -> F Inlines -> F Blocks
    labelDiv blk value =
@@ -325,12 +319,16 @@ codeBlock blockAttrs blockType = do
    exportsResults :: [(String, String)] -> Bool
    exportsResults = maybe False (`elem` ["results", "both"]) . lookup "exports"
 
-trailingResultsBlock :: PandocMonad m => OrgParser m (Maybe (F Blocks))
-trailingResultsBlock = optionMaybe . try $ do
+-- | Parse the result of an evaluated babel code block.
+babelResultsBlock :: PandocMonad m => OrgParser m (F Blocks)
+babelResultsBlock = try $ do
   blanklines
-  stringAnyCase "#+RESULTS:"
-  blankline
+  resultsMarker <|>
+    (lookAhead . void . try $
+      manyTill (metaLineStart *> anyLineNewline) resultsMarker)
   block
+ where
+  resultsMarker = try . void $ stringAnyCase "#+RESULTS:" *> blankline
 
 -- | Parse code block arguments
 codeHeaderArgs :: Monad m => OrgParser m ([String], [(String, String)])
diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs
index 5dc742403..33c212bca 100644
--- a/src/Text/Pandoc/Readers/Org/Meta.hs
+++ b/src/Text/Pandoc/Readers/Org/Meta.hs
@@ -44,7 +44,7 @@ import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Class (PandocMonad)
 import Text.Pandoc.Definition
 
-import Control.Monad (mzero, void)
+import Control.Monad (mzero, void, when)
 import Data.Char (toLower)
 import Data.List (intersperse)
 import qualified Data.Map as M
@@ -75,7 +75,9 @@ declarationLine :: PandocMonad m => OrgParser m ()
 declarationLine = try $ do
   key   <- map toLower <$> metaKey
   (key', value) <- metaValue key
-  updateState $ \st -> st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
+  when (key' /= "results") $
+    updateState $ \st ->
+      st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
 
 metaKey :: Monad m => OrgParser m String
 metaKey = map toLower <$> many1 (noneOf ": \n\r")
diff --git a/test/command/3706.md b/test/command/3706.md
new file mode 100644
index 000000000..00f53279e
--- /dev/null
+++ b/test/command/3706.md
@@ -0,0 +1,44 @@
+Results marker can be hidden in block attributes (#3706)
+
+```
+pandoc -f org -t native
+#+BEGIN_SRC R :exports results :colnames yes
+   data.frame(Id = 1:3, Desc = rep("La",3))
+#+END_SRC
+
+#+CAPTION: Lalelu.
+#+LABEL: tab
+#+RESULTS:
+| Id | Desc |
+|----+------|
+|  1 | La   |
+|  2 | La   |
+|  3 | La   |
+^D
+[Table [Str "Lalelu."] [AlignDefault,AlignDefault] [0.0,0.0]
+ [[Plain [Str "Id"]]
+ ,[Plain [Str "Desc"]]]
+ [[[Plain [Str "1"]]
+  ,[Plain [Str "La"]]]
+ ,[[Plain [Str "2"]]
+  ,[Plain [Str "La"]]]
+ ,[[Plain [Str "3"]]
+  ,[Plain [Str "La"]]]]]
+```
+
+```
+pandoc -f org -t native
+#+BEGIN_SRC R :exports none :colnames yes
+   data.frame(Id = 1:2, Desc = rep("La",2))
+#+END_SRC
+
+#+CAPTION: Lalelu.
+#+LABEL: tab
+#+RESULTS:
+| Id | Desc |
+|----+------|
+|  1 | La   |
+|  2 | La   |
+^D
+[]
+```