Erro em tempo de execução 1004

[asbgrodrigo]

Ola amigos, sou novo aqui no forum e tambem na area de suporte.
Estou com um problema com uma macro do excel com o seguinte erro:

Erro em tempo de execução 1004

O metodo range do objeto global falhou.

Segue o codigo e tambem o anexo da planilha.

Desde ja agradeço.

Sub TabDinamica_xml()
'
' TabDinamica_xml Macro
'
'
Dim Nlinha, nColuna, nColuna1, nColuna2 As Integer
Dim Slinha, Slinha1, Sformula, sWork As String
Dim sColuna, sColuna1, sColuna2 As String
Dim Slinha2, Slinha3, Slinha4, Slinha5, Slinha6 As String
Dim FaixaDados, letras(100) As String

letras(1) = "A": letras(2) = "B": letras(3) = "C": letras(4) = "D"
letras(5) = "E": letras(6) = "F": letras(7) = "G": letras(8) = "H"
letras(9) = "I": letras(10) = "J": letras(11) = "K": letras(12) = "L"
letras(13) = "M": letras(14) = "N": letras(15) = "O": letras(16) = "P"
letras(17) = "Q": letras(18) = "R": letras(19) = "S": letras(20) = "T"
letras(21) = "U": letras(22) = "V": letras(23) = "W": letras(24) = "X"
letras(25) = "Y": letras(26) = "Z": letras(27) = "AA": letras(28) = "AB"
letras(29) = "AC": letras(30) = "AD": letras(31) = "AE": letras(32) = "AF"
letras(33) = "AG": letras(34) = "AH": letras(35) = "AI": letras(36) = "AJ"

ChDir "C:\XMLCONTROL"
Workbooks.Open Filename:="C:\XMLCONTROL\KXMLSUM.xls"
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=CELL(""lin"",RC[-1])"
Nlinha = ActiveCell.Value
ActiveCell.Value = ""
Slinha = Format(Nlinha - 1)
Slinha1 = "R" + Slinha + "C6"
FaixaDados = "KXMLSUM!R1C1:" + Slinha1 '"KXMLSUM!R1C1:R6450C6"

Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
FaixaDados, Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:="Plan1!R3C1", TableName:="Tabela dinâmica2", _
DefaultVersion:=xlPivotTableVersion10
Sheets("Plan1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KEY")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KEY").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("Tabela dinâmica2").AddDataField ActiveSheet. _
PivotTables("Tabela dinâmica2").PivotFields("KEY05"), "Soma de KEY05", xlSum
With ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KXCLFO04")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KXCLFO04").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
With ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KXFLCF04")
.Orientation = xlRowField
.Position = 3
End With
ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KXFLCF04").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
With ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KXNOME04")
.Orientation = xlRowField
.Position = 4
End With
ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("KXNOME04").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
With ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields("DATA04")
.Orientation = xlColumnField
.Position = 1
End With
Range("E3").Select
With ActiveSheet.PivotTables("Tabela dinâmica2")
.ColumnGrand = True
.RowGrand = False
End With
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("1:3").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Windows("KXMLSUM.xls").Activate
Sheets("KXMLSUM").Select
ActiveWindow.SelectedSheets.Delete


Rows("1:1").Select
Selection.Font.Bold = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
ActiveCell.FormulaR1C1 = "Código"
Range("B1").Select
ActiveCell.FormulaR1C1 = "c/f"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Nome"

Range("C1").Select
'Selection.End(xlToRight).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=CELL(""lin"",RC[-1])"
Nlinha = ActiveCell.Value
ActiveCell.Value = ""
Slinha = Format(Nlinha - 1)
ttLinha = Nlinha
Slinha2 = "A2:A" + Slinha
'--------------------------------------------------------
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "dif"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
'------------------------------------------------------------
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=CELL(""col"",RC[-1])"
Nlinha = ActiveCell.Value
ActiveCell.Value = ""
Slinha3 = "A1:" + letras(Nlinha) + Slinha
'------------------------------------------------------------
Slinha4 = letras(Nlinha) + "2:" + letras(Nlinha) + Slinha
Slinha8 = letras(Nlinha) + "2:" + letras(Nlinha) + Format(ttLinha)
SRange = letras(Nlinha) + "2"
Range(SRange).Select
Selection.AutoFill Destination:=Range(Slinha8) 'Range("R2:R754")
Range(Slinha8).Select
Slinha5 = letras(Nlinha) + ":" + letras(Nlinha)
Columns(Slinha5).Select
Selection.Style = "Comma"
Selection.NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""??_);_(@_)"
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"

'--------------------------------------------------------

'Cells.Select
SRangeX = "A1:" + letras(Nlinha) + Format(ttLinha - 1)
Range(SRangeX).Select
ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range(Slinha4) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range(Slinha2) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Plan1").Sort
.SetRange Range(Slinha3)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

sUltLinha = Format(ttLinha) + ":" + Format(ttLinha)
Rows(sUltLinha).Select
Selection.Cut
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("A1").Select

SRange2 = "A2:" + letras(Nlinha) + "2"
Range(SRange2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
SRange = "D1:" + letras(Nlinha - 1) + "2"
SRange2 = "Plan1!$D$1:$" + letras(Nlinha - 1) + "2"
Range(SRange).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range(SRange2) '"Plan1!$D$1:$Q$2"
ActiveSheet.Shapes("Gráfico 1").IncrementLeft -124.5
ActiveSheet.Shapes("Gráfico 1").IncrementTop 78
Sheets("Plan1").Select
Sheets("Plan1").Name = "Resumido"
ActiveWorkbook.SaveAs Filename:="C:\XMLCONTROL\KXMLResumo.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("MacroControleXML.xlsm").Activate
ActiveWorkbook.Close
End Sub

Macro.rar

(36.86 KiB) Baixado 190 vezes