Question

您好我有以下VBA代码，它在一个地方一次又一次失败。

Sub theathersplitmacro()

Dim SDrv   As String
Dim DDrv   As String
Dim Sfname As String
Dim Dfname As String
Dim wkbSrc As Workbook
Dim wkbDst As Workbook
Dim shtname(1 To 16) As Variant
Dim i As Integer
Dim Lastrow As Variant
Dim destination_file As String
'Dim regions As String
Dim theater As String
Dim j As Integer


For j = 2 To 9

destination_file = Workbooks("VBA Master 
Copy.xlsb").Sheets("Data").Range("A" & j).Value & ".xlsb"
'regions = Workbooks("VBA Master Copy.xlsb").Sheets("Data").Range("C" & 
j).Value
theater = Workbooks("VBA Master Copy.xlsb").Sheets("Data").Range("D" & 
j).Value



shtname(1) = "DataQTR"
shtname(2) = "DataSWDriver"
shtname(3) = "DataMTD"
shtname(4) = "DataWeekly"
shtname(5) = "DataSoftware"
shtname(6) = "DataCloud"
shtname(7) = "DataServices"
shtname(8) = "TopCustomer"
shtname(9) = "TopDeals"
shtname(10) = "TopPartners"
shtname(11) = "DataForecast"
shtname(12) = "DataFcstCloud"
shtname(13) = "DataFcstSoftware"
shtname(14) = "DataFcstServices"
shtname(15) = "DataServicesSW"
shtname(16) = "TopCustomerDebooking"

SDrv = "C:\Users\skumawat\Documents\Explore\"
Sfname = "Theater_Bookings - New Format with formulae.xlsb"

 DDrv = "C:\Users\skumawat\Documents\Explore\"
  Dfname = destination_file



   With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
   End With


    Set wkbSrc = Workbooks.Open(SDrv & Sfname)
    Set wkbDst = Workbooks.Open(DDrv & Dfname)



For i = 1 To 15

  wkbSrc.Worksheets(shtname(i)).Activate
  Lastrow = wkbSrc.Worksheets(shtname(i)).Range("k" & 
  Rows.Count).End(xlUp).Row
 wkbSrc.Worksheets(shtname(i)).Range("A1:BZ" & Lastrow).Select


 If Worksheets(shtname(i)).AutoFilterMode = True Then
 wkbSrc.Worksheets(shtname(i)).AutoFilter.Sort.SortFields.Clear
 End If

 wkbSrc.Worksheets(shtname(i)).Range("A1:BZ" & Lastrow).Select
 Selection.AutoFilter




 wkbSrc.Worksheets(shtname(i)).Range("$k$1:$k$" & Lastrow).AutoFilter 
 Field:=11, Criteria1:=theater



 Range("$A$1:$BZ$" & Lastrow).SpecialCells(xlCellTypeVisible).Copy

 wkbDst.Worksheets(shtname(i)).Range("A1").PasteSpecial 
 xlPasteValuesAndNumberFormats

 Application.CutCopyMode = False



 Next i

 wkbDst.Worksheets("aMapping").Activate

 Range("A2").Select

 Range(Selection, Selection.End(xlDown)).Select
 Selection.ClearContents

 Workbooks("VBA Master Copy.xlsb").Sheets("Data").Activate

 Range("G" & j).Select

 Range(Selection, Selection.End(xlToRight)).Select
 Selection.Copy

 wkbDst.Worksheets("aMapping").Activate
 Range("A2").Select

 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks 
  _
     :=False, Transpose:=True

   Application.CutCopyMode = False



  With wkbDst
    .Save
    .Close
   End With

  Workbooks("VBA Master Copy.xlsb").Sheets("Data").Range("E" & j).Value = 
   "Completed"


     Next j


    With wkbSrc
      .Close
    End With

    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
    End With

    Workbooks("VBA Master Copy.xlsb").Activate


    End Sub

我得到的错误在以下一行

wkbSrc.Worksheets(shtname(i)).Range("$k$1:$k$" & Lastrow).AutoFilter 
    Field:=11, Criteria1:=theater

Answer 1

你使用了错误的范围。要再次为自动过滤器用户设置范围"A1:BZ" & lastrow。如果您只使用$ K，那么您的标准就没有第11列。

自动过滤器超出范围

1 个答案: