Dividir Sub

Mensagens : 17 Data de inscrição : 04/02/2013

Bom dia,

Minha macro está com mais de 130 kB, como o límite é de 64 kB, tem como eu dividir a sub em várias subs ainda acionando com apenas um botão? Alguém poderia me ajudar?

Assunto: Re: Dividir Sub Qui Fev 07, 2013 6:01 pm

Boa tarde!!

Tente poli sua macro, deixe sua atual rotina depositada no fórum!!

Att

Mensagens : 17 Data de inscrição : 04/02/2013

Eu fiz várias modificações e o tamanho reduziu para 87 KB. Ainda também não compila porque diz que Call cabecalho ou Call responsavel, o argumento não é opcional, segue o código:

Private Sub ImportarTXTListaMaterial_Click()
Dim Campos As Variant
Dim Arquivotxt, Arquivoxls, aux1, aux2, aux3, cola, colb, colc, cold, cole, aspas, layermm As String
Dim layeraspas, arra(941), responsavel, responsavel1, responsavel2, especialidade, especialidade1 As String
Dim especialidade2, strNome, var1, var2 As String
Dim i As Long, j As Long, a As Long
Dim contador, lin, z, quantidade, contresp, intErro, tamanho As Integer
contador = 0
Dim oApp As Excel.Application
Dim oWks As Excel.Workbook
Dim filename As Variant
Dim Colunasa, Colunasb, Colunasc, Colunasd, Colunase As Range
Dim nomealtair, espaltair, nomepedro, esppedro As String
nomealt = "xxxxxxx"
espalt = " xxxxxx"
nomep = "xxxxxxx"
espp = " xxxxxx"
'Nome do responsável - Caixa de Diálogo Windows
strNome = InputBox(Prompt:="Informe nome do Responsável (P/A/Ambos): ", _
Title:="QUAL O SEU NOME")
'se não informou nada e cancelou então sai
If strNome = "seu nome" Or strName = vbNullString Then
Exit Sub
Else
Select Case strNome
Case "Alt"
contresp = 0
responsável = nomealt
especialidade = espalt
Case "P"
contresp = 1
responsável = nomep
especialidade = espp
Case "Ambos"
contresp = 2
responsável1 = nomealt
especialidade1 = espalt
responsável2 = nomep
especialidade2 = espp
Case Else
intErro = MsgBox(Prompt:="Nome do responsável incorreto!", _
Buttons:=0)
Exit Sub
End Select
End If
'abre um "mini" explorer de arquivos
Arquivotxt = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")
'retorna o nome do arquivo aberto
filename = Application.GetOpenFilename(, , "Select Programme")
filename = Mid(filename, InStrRev(filename, "\") + 1)
'abre o arquivo texto
Open Arquivotxt For Input As #1
'Novo arquivo excel
Set oApp = New Excel.Application
Set oWks = oApp.Workbooks.Add
oWks.SaveAs "C:\Autodesk\AutoCAD_2012_English_Win_64bit\Minhas Rotinas\" & filename & ".xls"
ActiveSheet.Name = "Plan1"
'Sheet INC
Sheets.Add
ActiveSheet.Name = "INC"
Sheets("INC").Move After:=Sheets("Plan1")
'Sheet E.S. E A.P.
Sheets.Add
ActiveSheet.Name = "E.S. E A.P."
Sheets("E.S E A.P.").Move After:=Sheets("INC")
'Sheet A.F.
Sheets.Add
ActiveSheet.Name = "A.F."
Sheets("A.F.").Move After:=Sheets("E.S. E A.P.")
'Sheet A.Q.
Sheets.Add
ActiveSheet.Name = "A.Q."
Sheets("A.Q.").Move After:=Sheets("A.F.")
'Trabalhando na sheet plan1
Worksheets("Plan1").Activate
Set Colunasa = Range("A1:A20000")
Set Colunasb = Range("B1:B20000")
Set Colunasc = Range("C1:C20000")
Set Colunasd = Range("D1:D20000")
Set Colunase = Range("E1:E20000")
'Enquanto não chega ao fim do arquivo texto
While Not (EOF(1))
'Captura 1 linha e armazena na variável Linha
Line Input #1, linha
'separa os campos e armazena na variável "Campos"
Campos = Split(linha, "")
'Distribui os campos na planilha
For j = 0 To UBound(Campos)
Cells(i, j + 1).Value = Campos(j)
Next
'incrementa uma linha
i = i + 1
Wend
'fecha o arquivo texto
Close #1
'Array com todos os materiais que existem na lista, tirado da plan2 da Planilha Modelo
a = 0
linha = 9
For a = 0 To 940
Arquivoxls = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivoxls
Sheets("Plan2").Activate
If Cells(linha, 2).Value = "" Then
arra(a) = 0
Else
arra(a) = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
'Cells(linha, 2).Select
End If
linha = linha + 1
Next
'Cerne do programa lê cada linha importada do txt e adiciona quantidade na tabela
For l = 2 To UBound(Campos)
cola = Cells(1, l).Value
colb = Cells(1, l).Value
colc = Cells(1, l).Value
cold = Cells(1, l).Value
cole = Cells(1, l).Value
aux1 = InStr(ca, "Tubo", 1)
quantidade = Left(ca, (aux1 - 2))
aux2 = InStr(ca, "mm", 1)
aspas = Chr(34)
aux3 = InStr(ca, aspas, 1)
tamanho = Len(ca)
layermm = Right(ca, ((tamanho - aux2) - 2))
layeraspas = Right(ca, ((tamanho - aux3) - 1))
cb = Right(ca, ((tamanho - aux1) + 1))
'cb = quantidade
ce = Left(ca, ((tamanho - aux1) + 1))
quantidade = CInt(ce)
cc = layermm
cd = layeraspas
If cd = "INC" Then
i = 1
j = 182
z = 0
For i = 1 To 9
If arra(i) = cb Then
Sheets("INC").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
ElseIf cc = "E.S. E A.P." Then
i = 10
j = 102
z = 0
For i = 10 To 14
If arra(i) = cb Then
Sheets("E.S. E A.P.").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
ElseIf cc = "A.F" Then
i = 15
j = 196
z = 0
For i = 15 To 23
If arra(i) = cb Then
Sheets("A.F.").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
ElseIf cc = "A.Q." Then
i = 24
j = 231
z = 0
For i = 24 To 32
If arra(i) = cb Then
Sheets("A.Q.").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
End If
'Monta INC
Worksheets("INC").Activate
'Cabeçalho
var1 = "PREVENÇÃO DE INCÊNDIO"
var2 = ""
Call cabecalho
'Assinatura
lin = 279
Call responsavel
'Insere índice de Elementos
i = 1
For contador = 9 To 211
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Locked = True
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
j = 204
For contador = 211 To 235 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = j
End With
Selection.Merge 'Mescla
j = j + 1
Next
i = 216
For contador = 236 To 267
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
j = 248
For contador = 268 To 274 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = j
End With
Selection.Merge 'Mescla
j = j + 1
Next
'Oculta Linha 275
Cells(275, 1).Select
With Selection
.EntireRow.Hidden = True
End With
'Insere unidades
For contador = 9 To 181
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 182 To 190
Cells(contador, 6).Value = "Br"
With Cells
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 191 To 211
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 212 To 235 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = "Pç"
End With
Selection.Merge 'Mescla
Next
For contador = 236 To 267
Cells(contador, 1).Value = "Pç"
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 268 To 274 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = "Pç"
End With
Selection.Merge 'Mescla
Next
'Busca discriminação dos materiais na sheet da planilha que gera a macro
linha = 9
For contador = 9 To 274
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("Plan").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
'Monta E.S. E A.P.
Worksheets("E.S. E A.P.").Activate
'Cabeçalho
var1 = "ESGOTO SANITÁRIO/ ÁGUAS PLUVIAIS"
var2 = "TUBOS E CONEXÕES"
Call cabecalho
'Assinatura
lin = 151
Call responsavel
'Tipos de Materiais para serem discriminados
Range("A117:F117").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "ACESSÓRIOS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
Range("A140:F140").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "DIVERSOS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
'Insere índice para cada elemento da lista de material
i = 1
For contador = 9 To 116
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 109
For contador = 118 To 139
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 131
For contador = 141 To 147
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
'Insere unidade para cada elemento da lista de material
For contador = 9 To 101
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 102 To 116
Cells(contador, 6).Value = "Br"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 118 To 139
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 141 To 147
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
'Busca discriminação do material
linha = 277
For contador = 9 To 116
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 385
For contador = 118 To 139
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 407
For contador = 141 To 147
Range(Cells(contador, 2), Cells(contador, 4)).Selection
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
'Sheet A.F.
Worksheets("A.F.").Activate
'Cabeçalho
var1 = "ÁGUA FRIA"
var2 = "TUBOS E CONEXÕES"
Call cabecalho
'Assinatura
lin = 284
Call responsavel
'Tipos de materiais a serem discriminados
Range("A251:F251").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "METAIS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Range("A251:F251").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "ACESSÓRIOS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
Range("A257:F257").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "DIVERSOS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
'Insere índice para cada elemento da lista de material
i = 1
For contador = 9 To 205
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 198
For contador = 207 To 250
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 242
For contador = 252 To 256
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 247
For contador = 258 To 273
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
j = 262
For contador = 274 To 279 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = j
End With
Selection.Merge 'Mescla
j = j + 1
Next
'Insere unidade para cada elemento da lista de material
For contador = 9 To 195
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 196 To 205
Cells(contador, 6).Value = "Br"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 207 To 250
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 252 To 256
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 258 To 273
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 274 To 279 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = "Pç"
End With
Selection.Merge 'Mescla
Next
'Busca discriminação do material
linha = 420
For contador = 9 To 205
Range(Cells(contador, 2), Cells(contador, 4)).Selection
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("A.F.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 617
For contador = 207 To 250
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 661
For contador = 252 To 256
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 666
For contador = 258 To 279
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
'Monta A.Q.
Worksheets("A.Q.").Activate
'Cabeçalho
var1 = "ÁGUA QUENTE"
var2 = "TUBOS E CONEXÕES"
Call cabecalho
'Assinatura
lin = 285
Call responsavel
'Tipos de materiais a serem discriminados
Range("A240:F240").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "METAIS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Range("A252:F252").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "ACESSÓRIOS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
Range("A256:F256").Select 'Celulas
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = "DIVERSOS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
'Insere índice para cada elemento da lista de material
i = 1
For contador = 9 To 239
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 223
For contador = 241 To 251
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 234
For contador = 253 To 255
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
i = 237
For contador = 257 To 277
Cells(contador, 1).Value = i
i = i + 1
With Cells
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
j = 257
For contador = 278 To 281 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = j
End With
Selection.Merge 'Mescla
j = j + 1
Next
'Insere unidade para cada elemento da lista de material
For contador = 9 To 239
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 241 To 251
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 253 To 255
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.WrapText = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 257 To 277
Cells(contador, 6).Value = "Pç"
With Cells
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Next
For contador = 278 To 281 Step 2
i = contador + 1
Range(Cells(contador, 1), Cells(i, 1)).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Value = "Pç"
End With
Selection.Merge 'Mescla
Next
'Busca discriminação do material
linha = 690
For contador = 9 To 239
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("A.F.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 921
For contador = 241 To 251
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 932
For contador = 253 To 255
Range(Cells(contador, 2), Cells(contador, 4)).Select
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
linha = 935
For contador = 257 To 281
Range(Cells(contador, 2), Cells(contador, 4)).Selection
Arquivo = ActiveWorkbook.Path & "" & "Lista_De_Material_Modelo" & ".xls"
Workbooks.Open filename:=Arquivo
Sheets("E.S. E A.P.").Activate
If Cells(linha, 2).Value = "" Then
valor = 0
Else
valor = Cells(linha, 2).Value
ActiveWorkbook.Close
Windows(filename & ".xls").Activate
Cells(linha, 2).Select
End If
With Selection
.HorizontalAlignment.Left = True
.VerticalAlignment = xlBottom
.Value = valor
.Font.Bold = False
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
End With
Selection.Merge 'Mescla
linha = linha + 1
Next
End Sub
Private Sub CommandButton2_Click()

End Sub
Sub cabecalho(var1 As String, var2 As String)
Range("A1:F1").Select 'Celulas
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = "RELAÇÃO DE MATERIAIS"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 10
.Interior.ColorIndex = 48
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
Range("A2:F2").Select 'Celulas
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.RowHeight = 5
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Selection.Merge 'Mescla
Range("A3").Select 'Célula
With Selection
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Value = "Obra:"
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 9
End With
Range("A4").Select 'Célula
With Selection
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Value = "Local:"
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 9
End With
Range("A5").Select 'Célula
With Selection
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Value = "Assunto:"
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 9
End With
Range("B3:B5").Select 'Células
With Selection
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 9
End With
Range("C3:C4").Select 'Células
With Selection
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 9
.CollumnWidth = 50
End With
Range("C5").Select 'Célula
With Selection
.HorizontalAlignment = False
.VerticalAlignment = xlBottom
.Value = var1
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 9
.Font.Bold = True
.CollumnWidth = 50
End With
Range("A6:F6").Select 'Celulas
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.RowHeight = 5
End With
Range("F3:F6").Select 'Células
With Selection
.Borders(xlEdgeRight).LineStyle = xlDash
End With
Range("A7").Select 'Celula
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = "ITEM"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Interior.ColorIndex = 48
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Range("B7:D7").Select 'Celulas
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = "DISCRIMINAÇÃO"
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Interior.ColorIndex = 48
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
Range("E7").Select 'Celula
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = "QUANT."
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Interior.ColorIndex = 48
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Range("F7").Select 'Celula
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = "UNID."
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 8
.Interior.ColorIndex = 48
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Range("A8:F8").Select 'Celulas
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 10
.Value = var2
.Borders(xlEdgeTop).LineStyle = xlDash
.Borders(xlEdgeLeft).LineStyle = xlDash
.Borders(xlEdgeRight).LineStyle = xlDash
.Borders(xlEdgeBottom).LineStyle = xlDash
End With
Selection.Merge 'Mescla
End Sub
Sub responsavel(var1, var2 As String)
'Teste Responsável
Select Case contresp
Case 0
Cells(lin, 3).Value = responsavel
Cells((lin + 1), 3).Value = especialidade
Case 1
Cells(lin, 3).Value = responsável1
Cells((lin + 1), 3).Value = especialidade1

Case 2
Cells(lin, 3).Value = responsável1
Cells((lin + 7), 3).Value = responsável2
Cells((lin + 1), 3).Value = especialidade1
Cells((lin + Cool

, 3).Value = especialidade2
'Local para assinar
Cells((lin + 5), 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = " "
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 10
End With
'Nome empresa
Cells((lin + 6), 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = "PLANNER – PROJETOS E ENGENHARIA S/C LTDA."
.Font.Bold = False
.Font.Color = 41
.Font.Name = "Glowworm"
.Font.Size = 14
End With
'Nome e CREA Responsável
Cells((lin + 7), 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Times New Roman"
.Font.Size = 10
End With
'Especialidade Responsável
Cells((lin + Cool

, 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Times New Roman"
.Font.Size = 9
End With
End Select
'Local para assinar
Cells((lin - 2), 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = " "
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Arial"
.Font.Size = 10
End With
'Nome empresa
Cells((lin - 1), 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Value = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
.Font.Bold = False
.Font.Color = 41
.Font.Name = "Glowworm"
.Font.Size = 14
End With
'Local para assinar
Cells(lin, 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Times New Roman"
.Font.Size = 10
End With
'Especialidade Responsável
Cells((lin + 1), 3).Select
With Selection
.HorizontalAlignment = xlCenter 'Centraliza
.VerticalAlignment = xlBottom
.Font.Bold = True
.Font.Color = 1
.Font.Name = "Times New Roman"
.Font.Size = 9
End With
End Sub

[code]

Mensagens : 17 Data de inscrição : 04/02/2013

Resolvido passando os parâmetros ao chamar a sub: Call cabecalho(var1, var2) e Call responsavel(lin), sendo que na declaração das subs deve ser usado ByVal, Sub cabecalho (ByVal var1 As String, ByVal var2, As String) e Sub responsavel(Byval lin As Integer)!!

Assunto: Re: Dividir Sub Sex Fev 08, 2013 4:41 pm

Bom di!!

Cara que poluição!
Aqui tem tudo que precosa para evitar isso...
http://www.google.com.br/url?sa=t&rct=j ... 0656,d.eWU

Att

Mensagens : 17 Data de inscrição : 04/02/2013

Caro Alexandre,

A página não abre! thanks!

Assunto: Re: Dividir Sub Sex Fev 08, 2013 7:11 pm

Boa tarde!!

https://skydrive.live.com/?cid=a7053abac4239c0f&id=A7053ABAC4239C0F%211619
http://buscapdf.com.br/procurar/?t=VBA&ws=go&or=yb
Att

Mensagens : 17 Data de inscrição : 04/02/2013

Boa tarde,

Dei uma boa limpada na minha macro. Ficou assim:

Código:: Private Sub ImportarTXTListaMaterial_Click()
Dim Campos As Variant
Dim arra(941), Arquivotxt, ca, cb, cc, cd, ce, aspas, layermm As String
Dim layeraspas As String
Dim strNome, strName, var1, var2, sPath, auxfilename As String
Dim i, j, K, a, tamanho, comsPath, comArquivotxt, comauxfilename, aux1, aux2, aux3 As Long
Dim contador, lin, z, quantidade, contresp, intErro As Integer
contador = 0
Dim oApp As Excel.Application
Dim oWks As Excel.Workbook
Dim wsOrigem As Worksheet
Dim wsDestino As Worksheet
Dim filename As Variant

'abre um "mini" explorer de arquivos
Arquivotxt = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")
'abre o arquivo texto
Open Arquivotxt For Input As #1

K = 2
'Enquanto não chega ao fim do arquivo texto
While Not (EOF(1))
'Captura 1 linha e armazena na variável Linha
Line Input #1, linha
'separa os campos e armazena na variável "Campos"
Campos = Split(linha, ";")
'Distribui os campos na planilha
Dim Palavras(1) As String
For j = 0 To UBound(Campos)
Sheets("Plan3").Cells(K, j + 1).Value = Campos(j)
Next
'incrementa uma linha
K = K + 1
Wend
'fecha o arquivo texto
Close #1
'Manipulando para criar novo arquivo excel
comArquivotxt = Len(Arquivotxt)
'Coloque aqui todo o caminho onde a planilha Lista_De_Material_Modelo e o .txt estão
sPath = "C:\Autodesk\AutoCAD_2012_English_Win_64bit\Minhas Rotinas\"
comsPath = Len(sPath)
auxfilename = Right(Arquivotxt, (comArquivotxt - comsPath))
comauxfilename = Len(auxfilename)
filename = Left(auxfilename, (comauxfilename - 4))
'Novo arquivo excel
Set oApp = New Excel.Application
Set oWks = Workbooks.Add
Worksheets("Plan1").Activate
'Salva Excel Criado
oWks.SaveAs "C:\Autodesk\AutoCAD_2012_English_Win_64bit\Minhas Rotinas\" & filename & ".xls"
'Arquivos e Abas de Origem e Destino
Set wsOrigem = Workbooks("Lista_De_Material_Modelo").Worksheets("Plan3")
Set wsDestino = Worksheets("Plan1")
With wsOrigem
.Range("A2:A20000").Copy Destination:=wsDestino.Range("A2:A20000")
.Range("A2:A20000").Delete
End With
'Copia Modelos para a nova Pasta de Trabalho
ThisWorkbook.Sheets("INC").Copy Before:=oWks.Sheets(1)
ThisWorkbook.Sheets("E.S. E A.P.").Copy Before:=oWks.Sheets("INC")
ThisWorkbook.Sheets("A.F.").Copy Before:=oWks.Sheets("E.S. E A.P.")
ThisWorkbook.Sheets("A.Q.").Copy Before:=oWks.Sheets("A.F.")
'ThisWorkbook.Close SaveChanges:=True

'Cerne do programa lê cada linha importada do txt e adiciona quantidade na tabela

For l = 2 To 20000
ca = wsDestino.Cells(l, 1)

[color=red][u][b]aux1 = InStr(ca, "Tub[/color]o",[/u] 1)[/b]
quantidade = Left(ca, (aux1 - 2))
aux2 = InStr(ca, "mm", 1)
aspas = Chr(34)
aux3 = InStr(ca, aspas, 1)
tamanho = Len(ca)
layermm = Right(ca, ((tamanho - aux2) - 2))
layeraspas = Right(ca, ((tamanho - aux3) - 1))
cb = Right(ca, ((tamanho - aux1) + 1))
ce = Left(ca, ((tamanho - aux1) + 1))
quantidade = CInt(ce)
cc = layermm
cd = layeraspas
If cd = "INC" Then
i = 1
j = 182
z = 0
For i = 1 To 9
If arra(i) = cb Then
Sheets("INC").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
ElseIf cc = "E.S. E A.P." Then
i = 10
j = 102
z = 0
For i = 10 To 14
If arra(i) = cb Then
Sheets("E.S. E A.P.").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
ElseIf cc = "A.F" Then
i = 15
j = 196
z = 0
For i = 15 To 23
If arra(i) = cb Then
Sheets("A.F.").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
ElseIf cc = "A.Q." Then
i = 24
j = 231
z = 0
For i = 24 To 32
If arra(i) = cb Then
Sheets("A.Q.").Activate
Cells(j, 5).Value = z + quantidade
End If
j = j + 1
Next
End If
Next

End Sub

O problema é que ao chegar na linha destacada em vermelho dá um erro tipo 13 de tipos incompatíveis. Sabendo-se que minha variável ca é uma string, que a função Instr retorna um inteiro coloquei aux1, aux2 e aux3 como Integer, gerou o erro, declarei como string, long e até variant apenas e mesmo assim gerou o mesmo erro. Está faltando bem pouco! Alguém poderia me ajudar?

Mensagens : 17 Data de inscrição : 04/02/2013

Corrigindo a linha que gera erro:
aux1 = InStr(ca, "Tubo", 1)

aux1 = InStr(ca, "Tubo",1)

Mensagens : 17 Data de inscrição : 04/02/2013

Boa tarde,

Minha macro gera uma planilha. Como faço para ativar determina sheet dessa planilha para verificar e fazer comparações de valores. Estou utilizando assim:

Application.Workbooks(sPath & filename & ".xls").Worksheets("A.F.").Select

Mas gera o erro em tempo de execução 9 - Subscrito fora do intervalo. Eu pensei em fechar a planilha da macro após tirar os valores dela, mas assim fecha também a macro. Como mostro pra macro que as células em questão são de determinada sheet da planilha criada e salva pela macro? Outra dúvida também é: Cells(1,3).Value também vale quando o que estiver na célula for texto? Obrigado?

Mensagens : 17 Data de inscrição : 04/02/2013

Estava faltando um argumento na função!
Sintaxe

InStr([start, ]string1, string2[, compare])

Descrição:

start Opcional. Expressão numérica que define a posição inicial de cada pesquisa. Se omitido, a pesquisa iniciará na posição do primeiro caractere. Se start contiver Null, ocorrerá um erro. O argumento start será necessário, se compare for especificado.
string1 Obrigatória. Expressão de seqüência sendo pesquisada.
string2 Obrigatória. Expressão de seqüência de caracteres procurada.
compare Opcional. Especifica o tipo de comparação de seqüência de caracteres. Se compare for Null, ocorrerá um erro. Se compare for omitido, a configuração Option Compare determinará o tipo de comparação. Especifique um LCID (LocaleID) válido para usar regras específicas da localidade na comparação.

» Dividir horas por número
» ANINHAR FUNÇÃO SE COM FORMULA DE DIVIDIR