'Import a workbook with a lot of tabs and combine the data into one sheet

I am working on processing data that comes in a form where each variable is on a different worksheet. Some of the workbooks have up to 300 worksheets so I am trying to build a macro that will combine them all into one worksheet so it is easier to read. I think I am having a problem with my do loop, and I am getting Run Time error 9, subscript out of range. When I run the debug it seems it will go through the loop once but it gets an error the second time through and I am not sure why. Code is below:

Sub ImportData()
    Dim FileLocation As String
    Dim nCount As Integer
   Dim s As Integer
   Dim wb As Workbook
   Dim finalRow As Integer
   Dim n As Integer
    
    FileLocation = Application.GetOpenFilename
    If FileLocation = "False" Then
        Beep
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(Filename:=FileLocation)
    
    s = wb.Sheets.Count
    'MsgBox (s)
    
    
    'Find how many rows of data there are
        
    finalRow = Range("A100000").End(xlUp).Row
    'MsgBox (finalRow)
    
    'import date
    wb.Worksheets(1).Range("C3:C" & finalRow).Copy ThisWorkbook.Worksheets(1).Range("A1")
    
    n = 1
    
    
    Do While n < finalRow

    wb.Worksheets(n).Range("D3:D" & finalRow).Copy ThisWorkbook.Worksheets(n).Columns(n)
    
    n = n + 1
    'MsgBox (n)
  Loop
  
  
 

  
End Sub


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source