Hola a todos estoy teniendo problemas luego de la instalación de office 2013.
Tengo una macro que escribe datos entre distintas hojas de un libro.
Cuando trato de abrir un nuevo excel para continuar trabajando en otros archivos la macro comienza a pegar los valores en ese nuevo libro abierto.
Este es el códgo fuente:
Sub main()
Dim tRows As Long
Dim tCols As Long
Set tblForecast = Sheets("Forecast").ListObjects("Forecast")
Set tblForecastRows = tblForecast.ListRows
Set tblSales = Sheets("Sales").ListObjects("Sales")
With tblForecast.DataBodyRange
tRows = .Rows.Count
tCols = .Columns.Count
End With
For i = 1 To tRows
Year = tblForecast.DataBodyRange(i, 1).Value
Period = tblForecast.DataBodyRange(i, 2).Value
Product = tblForecast.DataBodyRange(i, 3).Value
ChannelId = tblForecast.DataBodyRange(i, 4).Value
SalesArea = tblForecast.DataBodyRange(i, 9).Value
CountryId = tblForecast.DataBodyRange(i, 10).Value
Tipo = tblForecast.DataBodyRange(i, 8).Value
BS = tblForecast.DataBodyRange(i, 11).Value
tblSales.Range.AutoFilter
tblSales.Range.AutoFilter Field:=2, Criteria1:=ChannelId
tblSales.Range.AutoFilter Field:=3, Criteria1:=SalesArea 'IIf(SalesArea = "Interior", "<>CGBA", SalesArea)
tblSales.Range.AutoFilter Field:=4, Criteria1:=CountryId
tblSales.Range.AutoFilter Field:=6, Criteria1:=BS
'If BS = "CONFECT" Then
Set rango = Nothing
On Error Resume Next
Set rango = tblSales.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible)
If rango Is Nothing Then
Sheets("Result").Select
If Range("A2").Value <> "" Then
fila = Range("A1").End(xlDown).Row + 1
Else
fila = 2
End If
Range("A" & fila).Value = ProductId
Range("B" & fila).Value = ChannelId
Range("D" & fila).Value = tblForecast.DataBodyRange(i, 5).Value
Range("E" & fila).Value = tblForecast.DataBodyRange(i, 6).Value
Range("F" & fila).Value = tblForecast.DataBodyRange(i, 7).Value
Range("G" & fila).Value = Tipo
Range("H" & fila).Value = Year
Range("I" & fila).Value = Period
Range("J" & fila).Value = SalesArea
Range("K" & fila).Value = CountryId
Else
rango.Copy
Sheets("Result").Select
If Range("a2").Value <> "" Then
fila = Range("A1").End(xlDown).Row + 1
Else
fila = 2
End If
'********CustomerId********
Range("c" & fila).Activate
ActiveCell.PasteSpecial xlPasteValues
'********ChannelId********
Set rango1 = tblSales.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)
rango1.Copy
Range("b" & fila).Activate
ActiveCell.PasteSpecial xlPasteValues
'********ProductId********
Range("a" & fila).Value = Product
Range("A" & fila).AutoFill Range("A" & fila & ":A" & Range("B1").End(xlDown).Row), xlFillCopy
'********Tipo********
Range("G" & fila).Value = Tipo
If Range("A1").End(xlDown).Row <> fila Then
Range("G" & fila).AutoFill Range("G" & fila & ":G" & Range("A1").End(xlDown).Row)
End If
'********Year********
Range("H" & fila).Value = Year
If Range("A1").End(xlDown).Row <> fila Then
Range("H" & fila).AutoFill Range("H" & fila & ":H" & Range("A1").End(xlDown).Row)
End If
'********Period********
Range("I" & fila).Value = Period
If Range("A1").End(xlDown).Row <> fila Then
Range("I" & fila).AutoFill Range("I" & fila & ":I" & Range("A1").End(xlDown).Row)
End If
'********SalesArea********
Set rango1 = tblSales.ListColumns(3).DataBodyRange.SpecialCells(xlCellTypeVisible)
rango1.Copy
Range("J" & fila).Activate
ActiveCell.PasteSpecial xlPasteValues
'********CountryId********
Set rango1 = tblSales.ListColumns(4).DataBodyRange.SpecialCells(xlCellTypeVisible)
rango1.Copy
Range("K" & fila).Activate
ActiveCell.PasteSpecial xlPasteValues
'********Business Segment********
Set rango1 = tblSales.ListColumns(6).DataBodyRange.SpecialCells(xlCellTypeVisible)
rango1.Copy
Range("L" & fila).Activate
ActiveCell.PasteSpecial xlPasteValues
Range("D" & fila).FormulaR1C1 = "=+SUMIFS(Forecast[Cases],Forecast[Type],RC7,Forecast[Year],RC8,Forecast[Period],RC9,Forecast[ChannelId],RC2,Forecast[ProductId],RC1, Forecast[BusinessSegment],RC12)" _
& " *Sumifs(Sales[Percent], Sales[CustomerId], RC3, Sales[ChannelId], RC2, Sales[BusinessSegment], RC12)"
'Forecast[SalesArea],RC10,
If Range("A1").End(xlDown).Row <> fila Then
Range("D" & fila).AutoFill Range("D" & fila & ":D" & Range("A1").End(xlDown).Row)
Range("D" & fila & ":D" & Range("A1").End(xlDown).Row).Select
Else
Range("D" & fila).Select
End If
Selection.Copy
Selection.PasteSpecial xlPasteValues
Range("E" & fila).FormulaR1C1 = "=+SUMIFS(Forecast[LSV],Forecast[Type],RC7,Forecast[Year],RC8,Forecast[Period],RC9,Forecast[ChannelId],RC2,Forecast[ProductId],RC1, Forecast[BusinessSegment],RC12)" _
& " *Sumifs(Sales[Percent], Sales[CustomerId], RC3, Sales[ChannelId], RC2, Sales[BusinessSegment], RC12)"
If Range("A1").End(xlDown).Row <> fila Then
Range("E" & fila).AutoFill Range("E" & fila & ":E" & Range("A1").End(xlDown).Row)
Range("E" & fila & ":E" & Range("A1").End(xlDown).Row).Select
Else
Range("e" & fila).Select
End If
Selection.Copy
Selection.PasteSpecial xlPasteValues
Range("F" & fila).FormulaR1C1 = "=+SUMIFS(Forecast[TONS],Forecast[Type],RC7,Forecast[Year],RC8,Forecast[Period],RC9,Forecast[ChannelId],RC2,Forecast[ProductId],RC1, Forecast[BusinessSegment],RC12)" _
& " *Sumifs(Sales[Percent], Sales[CustomerId], RC3, Sales[ChannelId], RC2, Sales[BusinessSegment], RC12)"
If Range("A1").End(xlDown).Row <> fila Then
Range("F" & fila).AutoFill Range("F" & fila & ":F" & Range("A1").End(xlDown).Row)
Range("F" & fila & ":F" & Range("A1").End(xlDown).Row).Select
Else
Range("F" & fila).Select
End If
Selection.Copy
Selection.PasteSpecial xlPasteValues
DoEvents
End If
'End If
Next
End Sub
