veja se atende

Sub Guardarsaida()
    
Dim L1 As Integer
Dim L2 As Integer
    
Dim RefM   As String
Dim Dt     As String
Dim Loc    As String
Dim Intv   As String
Dim CdReg  As String
Dim Coment As String
    
If Sheet2.Cells(2, 1).Value = "" Then
   L2 = 1
Else
   L2 = Sheet2.Cells(1, 1).End(xlDown).Row
End If

RefM = Sheet1.Cells(3, 3).Value
Dt = Sheet1.Cells(5, 3).Value
Loc = Sheet1.Cells(7, 3).Value
Intv = Sheet1.Cells(9, 3).Value
CdReg = Sheet1.Cells(11, 3).Value
Coment = Sheet1.Cells(13, 3).Value

L1 = 3

Do
  L1 = L1 + 1
  If Sheet1.Cells(L1, 5).Value = "" Then Exit Do

  L2 = L2 + 1
  Sheet2.Cells(L2, 1).Value = CdReg
  Sheet2.Cells(L2, 2).Value = RefM
  Sheet2.Cells(L2, 3).Value = Sheet1.Cells(L1, 5).Value
  Sheet2.Cells(L2, 4).Value = Sheet1.Cells(L1, 6).Value
  Sheet2.Cells(L2, 5).Value = Sheet1.Cells(L1, 8).Value
  Sheet2.Cells(L2, 6).Value = Sheet1.Cells(L1, 7).Value
  Sheet2.Cells(L2, 7).Value = Dt
  Sheet2.Cells(L2, 8).Value = Intv
  Sheet2.Cells(L2, 9).Value = Loc
  Sheet2.Cells(L2, 10).Value = Coment


Loop


End Sub