none
Problema con Macro Excel 2013 RRS feed

  • Pregunta

  • 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
    

    viernes, 10 de julio de 2015 14:27