Is the code in a standard module?  
(It should be.)

Where does .End(xlRight) take you?
(Offset(-1, 1) would be a problem in a first row or last column)

Are you using XL 2007?
(I'm sorry) <g>

I'm confused over what you're extracting, but this may give you some more ideas:

Option Explicit
Sub CopyBuysheets()

   Dim wbOther As Workbook
   Dim PathsList As Range
   Dim myCell As Range
   Dim fCtr As Long
   Dim myPath As String
   Dim RangeNames As Variant
   Dim rCtr As Long
   Dim TestRng As Range
   Dim myFile As String
   Dim myFileNames() As String
   Dim iCtr As Long
   Dim TestWks As Worksheet
   Dim DestCell As Range
   
   RangeNames = Array("absolut_total", _
                      "Cruzan_Total", _
                      "level_total", _
                      "plymouth_Total", _
                      "fris_total")
                     
   With ThisWorkbook.Worksheets("folders")
       Set PathsList = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
   End With
   
   'retrieve all the names of the files.
   fCtr = 0
   For Each myCell In PathsList.Cells
       myPath = myCell.Value
       If Right(myPath, 1) <> "\" Then
           myPath = myPath & "\"
       End If
       myFile = ""
       On Error Resume Next
       myFile = Dir(myPath & "*.xls")
       On Error GoTo 0

       Do While myFile <> ""
           If LCase(myFile) Like LCase("*.xls") Then
                fCtr = fCtr + 1
                ReDim Preserve myFileNames(1 To fCtr)
                myFileNames(fCtr) = myPath & myFile
           End If
           myFile = Dir()
       Loop
   Next myCell
   
   If fCtr > 0 Then
       'loop through the list of files
       For iCtr = LBound(myFileNames) To UBound(myFileNames)
           Application.EnableEvents = False
           Set wbOther = Workbooks.Open(Filename:=myFileNames(iCtr))
           Application.EnableEvents = True
           For rCtr = LBound(RangeNames) To UBound(RangeNames)
               Set TestRng = Nothing
               On Error Resume Next
               Set TestRng = wbOther.Names(RangeNames(rCtr)).RefersToRange
               On Error GoTo 0
               
               If TestRng Is Nothing Then
                   'no range by this name in that workbook
                   Beep '?
               Else
                   Set TestWks = Nothing
                   On Error Resume Next
                   Set TestWks = ThisWorkbook.Worksheets(TestRng.Parent.Name)
                   On Error GoTo 0
                   
                   If TestWks Is Nothing Then
                       Set TestWks = Worksheets.Add
                       TestWks.Name = TestRng.Parent.Name
                   End If
                   
                   With TestWks
                       Set DestCell = .Cells(1, .Columns.Count).End(xlToLeft)
                       If IsEmpty(DestCell.Value) Then
                           'stay put
                       Else
                           'move to the column to the right
                           Set DestCell = DestCell.Offset(0, 1)
                       End If
                       
                       DestCell.Value = myFileNames(iCtr) _
                                            & "--" & RangeNames(rCtr)
                       
                       TestRng.Areas(1).Columns(1).Copy
                       DestCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                   End With
               End If
           Next rCtr
           
           wbOther.Close savechanges:=False
       Next iCtr
   End If
   
End Sub