Excel 一个宏中断另一个宏代码如何解决?

Excel 一个宏中断另一个宏代码如何解决?,excel,vba,Excel,Vba,我学习宏已经有3周了。我偶然发现一个问题,希望你能帮助我。我的问题是:- 我有7个宏文件,只需说:- 1.abc.xlsm 2.def.xlsm 3.ghi.xlsm 4.jkl.xlsm 5.mno.xlsm 6.pqr.xlsm 7.stu.xlsm 所有这些宏中都有代码,包含10张图纸,其中一张图纸的名称在所有宏中都是相同的,让我们只看图纸8 我有宏,我们称之为soln.xlsm,它包含sheet8数据,每个月都会更新该

我学习宏已经有3周了。我偶然发现一个问题,希望你能帮助我。我的问题是:-

我有7个宏文件,只需说:-

    1.abc.xlsm
    2.def.xlsm
    3.ghi.xlsm
    4.jkl.xlsm
    5.mno.xlsm
    6.pqr.xlsm
    7.stu.xlsm 
    
所有这些宏中都有代码,包含10张图纸,其中一张图纸的名称在所有宏中都是相同的,让我们只看图纸8

我有宏,我们称之为soln.xlsm,它包含sheet8数据,每个月都会更新该表

我已经制作了宏soln.xlsm,如果运行它,它将进入文件夹并逐个填充所有7个宏

但当我运行它时,这给了我3个错误:-

  • 此工作簿包含一个或多个外部源的多个链接
  • 找不到项目库
  • 存在于7个宏中的代码会以某种方式被删除
  • 是他们在7 excel中隔离宏代码的任何方法,以便它不会被其他代码中断

    Sub CopyDataBlocks()
    
    'VARIABLE NAME                 'DEFINITION
    Dim SourceSheet As Worksheet    'The data to be copied is here
    Dim TargetSheet As Worksheet    'The data will be copied here
    Dim ColHeaders As Range         'Column headers on Target sheet
    Dim MyDataHeaders As Range      'Column headers on Source sheet
    Dim DataBlock As Range          'A single column of data
    Dim c As Range                  'a single cell
    Dim Rng As Range                'The data will be copied here (="Place holder" for the first data cell)
    Dim i As Integer
    
    
    'Change the names to match your sheetnames:
    Set SourceSheet = Sheets("Source")
    Set TargetSheet = Sheets("Target")
    
    
    With TargetSheet
        Set ColHeaders = .Range(.Cells(2, 1), .Cells(2, .Columns.Count).End(xlToLeft)) 'Or just .Range("A1:C1")
        Set Rng = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) 'Shoots up from the bottom of the sheet untill it bumps into something and steps one down
    End With
    
    
    With SourceSheet
        Set MyDataHeaders = .Range("A1:D1")
        
    'Makes sure all the column names are the same:
    'Each header in Source sheet must have a match on Target sheet (but not necessarily in the same order + there can be more columns in Target sheet)
        For Each c In MyDataHeaders
            If Application.WorksheetFunction.CountIf(ColHeaders, c.Value) = 0 Then
                MsgBox "Can't find a matching header name for " & c.Value & vbNewLine & "Make sure the column names are the same and try again."
                Exit Sub    'The code exits here if thereäs no match for the column header
            End If
        Next c
        
    'There was a match for each colum name.
    'Set the first datablock to be copied:
        Set DataBlock = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)) 'A2:A & the last cell with something on it on column A
    
    
    'Resizes the target Rng to match the size of the datablock:
        Set Rng = Rng.Resize(DataBlock.Rows.Count, 1)
    
    
    'Copies the data one column at a time:
        For Each c In MyDataHeaders
            i = Application.WorksheetFunction.Match(c.Value, ColHeaders, 0) 'Finds the matching column name
            Rng.Offset(, i - 1).Value = Intersect(DataBlock.EntireRow, c.EntireColumn).Value    'Writes the values
        Next c
    
    
    'Uncomment the following line if you want the macro to delete the copied values:
    '    Intersect(MyDataHeaders.EntireColumn, DataBlock.EntireRow).ClearContents
    
    
    End With
    
    
    End Sub
    
    
    sub abc()
    
    Thisworkbooks.sheets("sheet8").activate
    Range("AS3").formula = "VBA code is present" 
    End sub()
    

    上述2个代码在所有7个excel中都存在。

    请显示soln.xlsm的VBA代码,以便我们了解它的功能。请在7文件中提供有关VBA代码的详细信息。当soln.xlsm运行时,是否应该执行该代码?外部链接:如果您不需要指向外部文件的链接,那么最好将其删除。外部链接会让事情变得更复杂。如果你不包含代码,我们无法真正帮助你修复代码。我为更新太晚而道歉@TimWilliam@Stringeater抱歉,请检查我是否已更新该代码是abc.xlsm等中的代码?我们需要查看soln.xlsm中的代码“找不到项目或库”表示您的一个或多个文件具有错误的VBA项目引用:您需要找到并修复它。