Question

从另一个工作簿中获取值并将其粘贴到当前工作簿中（宏正在运行）。粘贴时，出现错误1004。问题是，根据活动单元格，此宏在工作表中运行多个范围。除了一个以外的所有作品。

这是问题的开始： 单元格（strRowBO_Mg，intColunaInputSKU）.Value = curBO_Mg

Sub Atualiza_Margem_Canal_2014()

    Dim strSKU As String
    Dim intColunaInputSKU As Integer
    Dim strRowBO_Mg As String
    Dim curTTC_Input As Currency
    Dim curTTV_Input As Currency
    Dim strRowTTC_Input As String
    Dim strRowTTV_Input As String
    Dim strRowTTC_Simulador As String
    Dim strRowTTV_Simulador As String
    Dim strRowMgBO_Simulador As String
    Dim intColumnCount As Integer
    Dim curBO_Mg As Currency
    Dim strCanal_Input As String
    Dim intRowCanal_Input As Integer
    Dim strBO_Input As String
    Dim strSimuladorAddressAndFileName As String
    Dim strSimulador_FileName As String
    Dim strPath As String
    Dim strFileName As String
    Dim wb As Workbook

    strBO_Input = Cells(1, 1).Value
    intColunaInputSKU = ActiveCell.Column


    If Cells(ActiveCell.Row - 1, 1) = "TTC/unit" Then

      strRowTTC_Input = ActiveCell.Row - 1

      strRowTTV_Input = ActiveCell.Row + 2

      strRowBO_Mg = ActiveCell.Row + 7

      strCanal_Input = Cells(ActiveCell.Row - 6, 1).Value

      intRowCanal_Input = ActiveCell.Row - 6
    Else

        If Cells(ActiveCell.Row - 1, 1) = "TTV/unit" Then

            strRowTTC_Input = ActiveCell.Row - 4

            strRowTTV_Input = ActiveCell.Row - 1

            strRowBO_Mg = ActiveCell.Row + 4

            strCanal_Input = Cells(ActiveCell.Row - 9, 1).Value

            intRowCanal_Input = ActiveCell.Row - 6

        Else

            MsgBox ("Erro input preço, reveja seu input e recomece")
            Exit Sub

        End If

    End If

    ThisWorkbook.Save

    strPath = Application.ActiveWorkbook.Path

    strSimulador_FileName = "Simulador OBPPC - 2014-2017 v2 - " & strBO_Input & " - " & strCanal_Input & ".xlsm"

    strSimuladorAddressAndFileName = strPath & "\" & strSimulador_FileName

    Set wb = Workbooks.Open(strSimuladorAddressAndFileName, 0)

    ThisWorkbook.Activate

    Cells(1, intColunaInputSKU).Activate

    Do

    strSKU = Cells(1, ActiveCell.Column)

    intColumnCount = ActiveCell.Column


    If strSKU = "Alu Bot 250" Then

        Cells(1, ActiveCell.Column + 1).Activate
        strSKU = Cells(1, ActiveCell.Column)
        intColumnCount = ActiveCell.Column

    End If

    If Cells(strRowTTC_Input, ActiveCell.Column) = "" Then

        Cells(strRowBO_Mg, ActiceCell.Column).ClearContents
        Cells(1, ActiveCell.Column + 1).Activate
        strSKU = Cells(1, ActiveCell.Column)
        intColumnCount = ActiveCell.Column

    End If


    intColunaInputSKU = ActiveCell.Column


    Windows(strSimulador_FileName).Activate

    strRowTTC_Simulador = WorksheetFunction.Match("Novo TTC" & strSKU, _
    Worksheets("Simulador").Range("R:R"), 0)

    strRowTTV_Simulador = WorksheetFunction.Match("Novo TTV" & strSKU, _
    Worksheets("Simulador").Range("R:R"), 0)

    strRowMgBO_Simulador = strRowTTV_Simulador + 1


    curTTC_Input = Worksheets("Simulador").Cells(strRowTTC_Simulador, 8)


    curTTV_Input = Worksheets("Simulador").Cells(strRowTTV_Simulador, 8)


    curBO_Mg = Worksheets("Simulador").Cells(strRowMgBO_Simulador, 8).Value

    ThisWorkbook.Activate

    **Cells(strRowBO_Mg, intColunaInputSKU).Value = curBO_Mg**

    Cells(strRowTTC_Input, intColunaInputSKU) = curTTC_Input

    Cells(strRowTTV_Input, intColunaInputSKU) = curTTV_Input

    Cells(1, ActiveCell.Column + 1).Activate

    Loop Until intColumnCount = 36


    Application.DisplayAlerts = False
    Workbooks(strSimulador_FileName).Close SaveChanges:=True
    Application.DisplayAlerts = True



    ThisWorkbook.Worksheets("2014").Cells(intRowCanal_Input, 1).Select


    MsgBox ("Margens de " & strBO_Input & " no canal: " & strCanal_Input & " atualizadas")

    End Sub

Answer 1

'Corrected Version!
'Major problem was Setting the ranges and unlocking cell that weren't supposed to be locked in the protected sheet I was working in.


Sub Atualiza_Margem_Canal_2014()
Dim strSKU As String
Dim intColunaInputSKU As Integer
Dim strRowBO_Mg As String
Dim curTTC_Input As Currency
Dim curTTV_Input As Currency
Dim strRowTTC_Input As String
Dim strRowTTV_Input As String
Dim strRowTTC_Simulador As String
Dim strRowTTV_Simulador As String
Dim strRowMgBO_Simulador As String
Dim intColumnCount As Integer
Dim curBO_Mg As Currency
Dim strCanal_Input As String
Dim intRowCanal_Input As Integer
Dim strBO_Input As String
Dim strSimuladorAddressAndFileName As String
Dim strSimulador_FileName As String
Dim strPath As String
Dim strFileName As String
Dim wbPerenidadeOBPPC As Workbook
Dim wbSimuladorFinancas As Workbook
Dim rngActiveCell As Range


'Pega nome do SKU como está no Simulador la em cima e a
'coluna referente para coltar com a margem

Set rngActiveCell = ActiveCell

Set wbPerenidadeOBPPC = ThisWorkbook

strBO_Input = Cells(1, 1).Value
intColunaInputSKU = rngActiveCell.Column


'caso atualize o TTC esta pegando os valores referentes de acordo onde esta a ActiveCell
If Cells(ActiveCell.Row - 1, 1) = "TTC/unit" Then

  strRowTTC_Input = rngActiveCell.Row - 1

  strRowTTV_Input = rngActiveCell.Row + 2

  strRowBO_Mg = rngActiveCell.Row + 7

  strCanal_Input = Cells(rngActiveCell.Row - 6, 1).Value

  intRowCanal_Input = rngActiveCell.Row - 6
Else
'caso atualize o TTV esta pegando os valores referentes de acordo onde esta a ActiveCell
    If Cells(ActiveCell.Row - 1, 1) = "TTV/unit" Then

        strRowTTC_Input = rngActiveCell.Row - 4

        strRowTTV_Input = rngActiveCell.Row - 1

        strRowBO_Mg = rngActiveCell.Row + 4

        strCanal_Input = Cells(rngActiveCell.Row - 9, 1).Value

        intRowCanal_Input = rngActiveCell.Row - 6

    Else
    'Tratando Erro
        MsgBox ("Erro input preço, reveja seu input e recomece")
        Exit Sub

    End If

End If

ThisWorkbook.Save

strPath = Application.ActiveWorkbook.Path

strSimulador_FileName = "Simulador OBPPC - 2014-2017 v2 - " & strBO_Input & " - " & strCanal_Input & ".xlsm"

'mudar nome para o riginal ao receber e extensão que fatalmente será xlsm
'strSimuladorFileName = "Copy of Layout Simulador - " & strCanal_Input & ".xlsx"

strSimuladorAddressAndFileName = strPath & "\" & strSimulador_FileName


Set wbSimuladorFinancas = Workbooks.Open(strSimuladorAddressAndFileName, 0)


wbPerenidadeOBPPC.Activate

Cells(1, intColunaInputSKU).Activate

Set rngActiveCell = ActiveCell


'Cells(1, intColunaInputSKU).Activate

Do

strSKU = Cells(1, intColunaInputSKU)


If strSKU = "Alu Bot 250" Then

    'MsgBox ("Não há cálculo de margem fornecido por finanças para este SKU: " & strSKU & ". Caso necessário insira a margem manualmente")
    'Exit Sub
    Set rngActiveCell = Cells(1, intColunaInputSKU + 1)
    strSKU = rngActiveCell
    intColunaInputSKU = intColunaInputSKU + 1

End If

If Cells(strRowTTC_Input, intColunaInputSKU) = "" Then

    Cells(strRowBO_Mg, intColunaInputSKU).ClearContents
    Cells(strRowTTV_Input, intColunaInputSKU).ClearContents
    Cells(1, intColunaInputSKU + 1).Activate
    intColunaInputSKU = intColunaInputSKU + 1
    strSKU = Cells(1, intColunaInputSKU)

End If



Windows(strSimulador_FileName).Activate

strRowTTC_Simulador = WorksheetFunction.Match("Novo TTC" & strSKU, _
Worksheets("Simulador").Range("R:R"), 0)

strRowTTV_Simulador = WorksheetFunction.Match("Novo TTV" & strSKU, _
Worksheets("Simulador").Range("R:R"), 0)

strRowMgBO_Simulador = strRowTTV_Simulador + 1

'Coluna 14 = N
curTTC_Input = Worksheets("Simulador").Cells(strRowTTC_Simulador, 8)

'Coluna 14 = N
curTTV_Input = Worksheets("Simulador").Cells(strRowTTV_Simulador, 8)

'Coluna 14 = N
curBO_Mg = Worksheets("Simulador").Cells(strRowMgBO_Simulador, 8)

wbPerenidadeOBPPC.Activate


Cells(strRowBO_Mg, intColunaInputSKU) = curBO_Mg

Cells(strRowTTC_Input, intColunaInputSKU) = curTTC_Input

Cells(strRowTTV_Input, intColunaInputSKU) = curTTV_Input


Cells(1, ActiveCell.Column + 1).Activate

intColunaInputSKU = intColunaInputSKU + 1

Loop Until intColunaInputSKU = 36


Application.DisplayAlerts = False
Workbooks(strSimulador_FileName).Close SaveChanges:=True
Application.DisplayAlerts = True

'ThisWorkbook.Activate


ThisWorkbook.Worksheets("2014").Cells(intRowCanal_Input, 1).Select


MsgBox ("Margens de " & strBO_Input & " no canal: " & strCanal_Input & " atualizadas")

End Sub

运行时错误1004 - 单元格中的变量（行索引，列索引）受保护的工作表

1 个答案: