Macro Help - Unable to decipher!

[RossShep92]

Hi

I have taken ownership of some spreadsheets, but the macro seems to not be working in one file as it normally does it multiple other files.

I can normally decipher whats wrong in them, but this one is stumping me.

The code is below and the text in bold & red is where it is getting stuck. the macro is filtering on an external spreadsheet relating to the criteria detailed, then copying and pasting into another spreadsheet by month.

Sub NewData()

Dim pCount As Integer, i As Integer, j As Integer, rCount As Integer

For j = 1 To UBound(ACList())
    Tracker.Sheets(ACList(j)).Activate

    DataSheet.Activate
    With ActiveSheet
        .AutoFilterMode = False
        With .Range("A1")
            .AutoFilter
            .AutoFilter Field:=2, Criteria1:="*19215*"
            .AutoFilter Field:=8, Criteria1:="*" & BU & "*"
            .AutoFilter Field:=3, Criteria1:="*" & ACList(j) & "*"
        End With
        .Range("D2").Select
    End With
  
    If ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 = 0 Then
        GoTo NoAccData
    End If
  
    Range(Selection, Selection.End(xlDown)).Resize(, 4).Copy
    Tracker.Sheets(ACList(j)).Activate
    Range("A61").PasteSpecial xlPasteValues
    DataSheet.Activate
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Tracker.Sheets(ACList(j)).Activate
    Range("E61").PasteSpecial xlPasteValues
    If Range("A61").Offset(1, 0).Value = "" Then
        pCount = Range("A61").Value
    Else
        pCount = Range("A61").End(xlDown).Value * 1
    End If
  
    rCount = 61
    For i = 1 To pCount
        DataSheet.Activate
        Range("A1").AutoFilter Field:=4, Criteria1:=i
        Range("I2").Select
        Range(Selection, Selection.End(xlDown)).Copy
        Tracker.Sheets(ACList(j)).Activate
        Cells(rCount, i + 5).PasteSpecial xlPasteValues
        DataSheet.Activate
        Range("I1").Select
        rCount = rCount + WorksheetFunction.Subtotal(3, Range(Selection, Selection.End(xlDown))) - 1
    Next
  
NoAccData:
Next

End Sub

The below is the data that is held externally that is copied and pasted

The below is the tab (split by object account code) that it should paste in to. It seems to get stuck at the paste value part of it as the information populates, but not the amount.

Any help appreciated

Thanks,
Ross

 

[RoryA]

Do you get an error?

 

[RossShep92]

Do you get an error?

Hi

Yes this is the error message

And this is the error when i press debug

Thanks,
Ross

 

[RoryA]

Try changing this section:

    For i = 1 To pCount
        DataSheet.Activate
        Range("A1").AutoFilter Field:=4, Criteria1:=i
        Range("I2").Select
        Range(Selection, Selection.End(xlDown)).Copy
        Tracker.Sheets(ACList(j)).Activate
        Cells(rCount, i + 5).PasteSpecial xlPasteValues
        DataSheet.Activate
        Range("I1").Select
        rCount = rCount + WorksheetFunction.Subtotal(3, Range(Selection, Selection.End(xlDown))) - 1
    Next

to this:

    For i = 1 To pCount
        With DataSheet
            .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=i
            If .Range("A1").CurrentRegion.Columns(1).SpecialCells(xlcelltypevisible).count > 1 then
               with .Range("I2", .Cells(.Rows.Count, "I").End(xlUp))
                   .Copy
                   Tracker.Sheets(ACList(j)).Cells(rCount, i + 5).PasteSpecial xlPasteValues
                   rCount = rCount + WorksheetFunction.Subtotal(3, .Cells)
               End With
            End If
        End With
    Next

 

[RossShep92]

Try changing this section:

    For i = 1 To pCount
        DataSheet.Activate
        Range("A1").AutoFilter Field:=4, Criteria1:=i
        Range("I2").Select
        Range(Selection, Selection.End(xlDown)).Copy
        Tracker.Sheets(ACList(j)).Activate
        Cells(rCount, i + 5).PasteSpecial xlPasteValues
        DataSheet.Activate
        Range("I1").Select
        rCount = rCount + WorksheetFunction.Subtotal(3, Range(Selection, Selection.End(xlDown))) - 1
    Next

to this:

    For i = 1 To pCount
        With DataSheet
            .Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:=i
            If .Range("A1").CurrentRegion.Columns(1).SpecialCells(xlcelltypevisible).count > 1 then
               with .Range("I2", .Cells(.Rows.Count, "I").End(xlUp))
                   .Copy
                   Tracker.Sheets(ACList(j)).Cells(rCount, i + 5).PasteSpecial xlPasteValues
                   rCount = rCount + WorksheetFunction.Subtotal(3, .Cells)
               End With
            End If
        End With
    Next

Hi again,

Sorry to come back to this!

It has now come up with the below error message when attempting this.


I have managed to expand the error message that the original code was getting to, and its saying the below if that helps!

Thanks,
Ross

 

[RoryA]

Which of those two errors are you getting now, and on which line?