Vc tem 2 posições que "fazem" um loop em sua rotina: Inicia com um While e logo abaixo For ;
então pela lógica deve ser "encerrado" com Next (para o For) e logo em seguida o Loop (para o while); porem seu codigo está invertido.
Tb há uma outra ocorrencia que causará erro : Logo abaixo do For há um IF sem end if; então acrescente um end if na linha abaixo do Exit for, ou coloque o exit for logo depois do then
Então: Se utilizar assim : "If dt = x Then Exit For" não há necessidade do exit for, caso contrario deverá ser
"If dt = x Then
Exit For
end if"

Reinaldo, voce tinha razão, fiz as alterações:
1- Coloquei o End If
2- Inverti a posição do LOOP com o Next
3 - Troquei o número das linhas, que tinha esquecido de trocar na adaptação deste exemplo.

3 - Troquei a posição da parte que fechava a plan2, pois estava antes do loop, então coloquei o "fecha Plan2" após o loop e, então, executei a macro, mas o sistema travou geral.

A rotina ficou assim:
Sub Atualizar()
Dim NovoExcel As New Excel.Application
Dim NovaPasta As New Excel.Workbook
Dim NomeAcao As String
Dim QtdAcao As String
Dim QtdNeg As String
Dim Volume As String
Dim PrecoFechamento As String
Dim NomeAcao2 As String
Dim QtdAcao2 As String
Dim QtdNeg2 As String
Dim Volume2 As String
Dim PrecoFechamento2 As String
Dim NomeAcao3 As String
Dim QtdAcao3 As String
Dim QtdNeg3 As String
Dim Volume3 As String
Dim PrecoFechamento3 As String
Dim NomeAba As String
Dim ColunaInicial As Integer
Dim x
Dim dt As Date, Td As String

dt = #12/30/2004#
Td = Format(dt, "MM-YYYY")
x = Sheets("Plan1").Range("A2").Value
PlanilhaIndice = ActiveWorkbook.Name
ColunaInicial = 3 ' Número da coluna que devemos começar a colocar os valores

Td = Format(dt, "MM-YYYY")
'Abre uma instância oculta no excel com o arquivo
NovoExcel.Visible = False
'Set NovaPasta = NovoExcel.Workbooks.Open("C:Exemplo.xlsm")
Set NovaPasta = Workbooks.Open(Environ("USERPROFILE") & "DesktopBaixar CotaçãoPLAN2.xlsm")
'Verifica última linha usada no arquivo aberto
'Copia os dados
PlanilhaCotacao = ActiveWorkbook.Name

Do While dt <= x

For i = ColunaInicial To 148 ' de 2004 à 2040 dá um total de 148 colunas

If dt = x Then ' caso a aba seja igual a data da celula, encerra o for
Exit For
End If

Sheets(Td).Select

'=======================================================================================================
NomeAcao = Cells(2, "F").Address 'define endereço das células que serão copiadas 1º linha
QtdAcao = Cells(2, "g").Address 'define endereço das células que serão copiadas 1º linha
QtdNeg = Cells(2, "h").Address 'define endereço das células que serão copiadas 1º linha
Volume = Cells(2, "i").Address 'define endereço das células que serão copiadas 1º linha
PrecoFechamento = Cells(2, "j").Address 'define endereço das células que serão copiadas 1º linha

NomeAcao2 = Cells(3, "F").Address 'define endereço das células que serão copiadas 2º linha
QtdAcao2 = Cells(3, "g").Address 'define endereço das células que serão copiadas 2º linha
QtdNeg2 = Cells(3, "h").Address 'define endereço das células que serão copiadas 2º linha ' ISSO É FIXO, NÃO PRECISA DE VARIÁVEL
Volume2 = Cells(3, "i").Address 'define endereço das células que serão copiadas 2º linha
PrecoFechamento2 = Cells(3, "j").Address 'define endereço das células que serão copiadas 2º linha

NomeAcao3 = Cells(4, "F").Address 'define endereço das células que serão copiadas 3º linha
QtdAcao3 = Cells(4, "g").Address 'define endereço das células que serão copiadas 3º linha
QtdNeg3 = Cells(4, "h").Address 'define endereço das células que serão copiadas 3º linha
Volume3 = Cells(4, "i").Address 'define endereço das células que serão copiadas 3º linha
PrecoFechamento3 = Cells(4, "j").Address 'define endereço das células que serão copiadas 3º linha
'=======================================================================================================
NomeAcao = NovaPasta.Sheets(Td).Range(NomeAcao) 'define endereço completo
QtdAcao = NovaPasta.Sheets(Td).Range(QtdAcao) 'define endereço completo
QtdNeg = NovaPasta.Sheets(Td).Range(QtdNeg) 'define endereço completo
Volume = NovaPasta.Sheets(Td).Range(Volume) 'define endereço completo
PrecoFechamento = NovaPasta.Sheets(Td).Range(PrecoFechamento) 'define endereço completo

NomeAcao2 = NovaPasta.Sheets(Td).Range(NomeAcao2) 'define endereço completo
QtdAcao2 = NovaPasta.Sheets(Td).Range(QtdAcao2) 'define endereço completo
QtdNeg2 = NovaPasta.Sheets(Td).Range(QtdNeg2) 'define endereço completo ' NESTE CASO, A ABA É VARIÁVEL (Td)
Volume2 = NovaPasta.Sheets(Td).Range(Volume2) 'define endereço completo
PrecoFechamento2 = NovaPasta.Sheets(Td).Range(PrecoFechamento2) 'define endereço completo

NomeAcao3 = NovaPasta.Sheets(Td).Range(NomeAcao3) 'define endereço completo
QtdAcao3 = NovaPasta.Sheets(Td).Range(QtdAcao3) 'define endereço completo
QtdNeg3 = NovaPasta.Sheets(Td).Range(QtdNeg3) 'define endereço completo
Volume3 = NovaPasta.Sheets(Td).Range(Volume3) 'define endereço completo
PrecoFechamento3 = NovaPasta.Sheets(Td).Range(PrecoFechamento3) 'define endereço completo
'=======================================================================================================
'Volta nesta pasta e cola
ThisWorkbook.ActiveSheet.Cells(4, ColunaInicial) = NomeAcao
ThisWorkbook.ActiveSheet.Cells(5, ColunaInicial) = QtdAcao
ThisWorkbook.ActiveSheet.Cells(6, ColunaInicial) = QtdNeg
ThisWorkbook.ActiveSheet.Cells(7, ColunaInicial) = Volume
ThisWorkbook.ActiveSheet.Cells(8, ColunaInicial) = PrecoFechamento

ThisWorkbook.ActiveSheet.Cells(10, ColunaInicial) = NomeAcao2
ThisWorkbook.ActiveSheet.Cells(11, ColunaInicial) = QtdAcao2
ThisWorkbook.ActiveSheet.Cells(12, ColunaInicial) = QtdNeg2
ThisWorkbook.ActiveSheet.Cells(13, ColunaInicial) = Volume2 ' NESTE CASO, A COLUNA É VARIÁVEL
ThisWorkbook.ActiveSheet.Cells(14, ColunaInicial) = PrecoFechamento2

ThisWorkbook.ActiveSheet.Cells(16, ColunaInicial) = NomeAcao3
ThisWorkbook.ActiveSheet.Cells(17, ColunaInicial) = QtdAcao3
ThisWorkbook.ActiveSheet.Cells(18, ColunaInicial) = QtdNeg3
ThisWorkbook.ActiveSheet.Cells(19, ColunaInicial) = Volume3
ThisWorkbook.ActiveSheet.Cells(20, ColunaInicial) = PrecoFechamento3

dt = DateAdd("m", 3, dt)

ColunaInicial = ColunaInicial + 1

Next
Loop

'Fecha novo Excel sem salvar e libera memória
NovaPasta.Close False
Set NovaPasta = Nothing
Set NovoExcel = Nothing
'=======================================================================================================

MsgBox "Terminado"
End Sub

Porque travou?

Bom estou um pouco confuso como o que vc realmente deseja.
É definido o valor de:
dt = #12/30/2004# (uma data)
depois:
x = Sheets("Plan1").Range("A2").Value (no caso uma string PLAN2)
depois:
Do While dt <= x (???)
Creio que ai está o problema, mas não evolui o resto

Perfeito, Reinaldo, muitíssimo obrigada, mais uma vez!