0

I wrote a code with a loop that copies a special cell in a source workbook and then opens another workbook and pastes a copied number to a special cell, and after seven times I get this error:

this is my code:

ActiveSheet.Paste Link:=True

I don't understand why it happens.

Sub Shadow()
    ActiveSheet.Range("$A$1:$I$9627").AutoFilter Field:=4, Criteria1:="basic"
    
    ' Copy filtered worksheet
    Number = Application.WorksheetFunction.Subtotal(3, Range("A1:A500000"))
    
    ActiveSheet.Range("$A$1:$I$9627").SpecialCells(xlCellTypeVisible).Copy
    
    ' Addition of new sheet
    Sheets.Add
    ActiveSheet.Paste
    
    ' Calculating number of rows
    finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' A loop for copying row by row number and date then opening shadowgraph for pasting copied data
    Dim i1 As Integer
    
    For i1 = 2 To finalrow
        ActiveSheet.Cells(i1, 1).Copy
        
        Workbooks.Open Filename:="E:\Attachment\PCI\Clutch disc\FLEXIBALE (RO)\Shadowgraph.xlsm"
        Windows("Shadowgraph.xlsm").Activate
        Range("AW5").Select
        
        ActiveSheet.Paste Link:=True
        
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Windows("ball99.xlsm").Activate
        
        ' Representing relative name for saving documents
        Dim Name1 As String
        Name1 = ActiveSheet.Cells(i1, 2) & "Shadowgraph"
        ActiveSheet.Cells(i1, 2).Copy
        Windows("Shadowgraph.xlsm").Activate
        Range("E32").Select
        
        ActiveSheet.Paste Link:=True
        
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        
        ' Set work directory
        ChDir "E:\Attachment\PCI\Clutch disc\FLEXIBALE (RO)"
        
        ' Set saving address
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "E:\Attachment\PCI\Clutch disc\FLEXIBALE (RO)\" & _
            Name1, Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
            
        Windows("Shadowgraph.xlsm").Activate
        
        ' Closing opened datasheets
        Windows("Shadowgraph.xlsm").Close (False)
    Next i1
    
    Windows("ball99.xlsm").Activate
    
    ' Closing every sheets except main workbook 01
    Dim ws1 As Worksheet
    For Each ws1 In ActiveWorkbook.Worksheets
        If ws1.Name <> "01" Then ws1.Visible = xlSheetHidden
    Next ws1
    
    ' Clearing all fiters
    ActiveSheet.ShowAllData
End Sub
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250

0 Answers0