Question

情况：每个月我需要获取一个数据源并重新格式化，以便可以将其转储到另一个文件中并更新数据透视表。我想使重新格式化的文件自动化，但是我还不太清楚最佳方法。理想情况下，我将在线下载数据源，将工作簿复制到此“自动化工作簿”并运行宏。因此，我已经记录了所需的宏。请参阅下面的参考，但是现在当我尝试运行复制到工作表上方时，出现“超出范围”错误。我想我需要一些可以让我在工作簿的工作表或所有工作表上复制的宏上运行宏的方法？

当前代码：

Sub Macro8()
'
' Macro8 Macro
'
' Keyboard Shortcut: Ctrl+Shift+M
'
    ActiveSheet.ListObjects("Combined3").Range.AutoFilter Field:=6, Criteria1:= _
        "A_AS1001 - UCS"
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 6.43
    Columns("M:N").Select
    Selection.Cut
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    Columns("L:L").Select
    Selection.Cut
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Amount Ads"
    Range("P193").Select
    Columns("P:P").ColumnWidth = 17.71
End Sub

Answer 1

这不是答案，而是一个附加功能，可以解决并解决问题。真正的问题是@Lambik的评论。但是，如果您无法控制下载的数据，则该代码将为您提供一些解决方法。添加仅在Macro开头提供的代码，它将检查表“ Combine3”的存在并为您提供一些替代方法

Dim ListNames, Choice, InPrompt As String, Lst As ListObject, have As Boolean, Lcnt, Lno As Integer
 Choice = "Combined3"
 have = False

 'Check for listobjects in the worksheet
 Lcnt = ActiveSheet.ListObjects.Count
 If Lcnt = 0 Then
 InPrompt = " No table found " & vbCrLf & " Click Cancel to Quit " & vbCrLf & " Or enter 1000 to Add Current Selection as Combine3" & vbCrLf
 Else
 'Gather listobjects names
 For Lno = 1 To Lcnt
 ListNames = ListNames & Lno & ". " & ActiveSheet.ListObjects(Lno).Name & vbCrLf
    If ActiveSheet.ListObjects(Lno).Name = Choice Then
    have = True
    Exit For
    End If
 Next Lno
 InPrompt = "Choose the Table Number of the following tables found to Auto filter " & vbCrLf & ListNames & " Or Click Cancel to Quit " & vbCrLf & " Or else enter 1000 to Add Current Selection as Combine3" & vbCrLf
 End If

 If have = False Then
 Choice = InputBox(InPrompt)
    Lno = Val(Choice)
    If (Lno = 0 Or Lno > ActiveSheet.ListObjects.Count) And Lno <> 1000 Then
    Choice = ""
    Else
        If Lno = 1000 Then
        ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Combined3"
        Choice = "Combined3"
        MsgBox ActiveSheet.ListObjects(Choice).Range.Address & " added as table Combined3"
        Else
        Choice = ActiveSheet.ListObjects(Val(Choice)).Name
        End If

    End If
 End If


 If Choice = "" Then
 MsgBox " No valid choice made.Click ok to Exit"
 Exit Sub
 End If

 'For trial purpose only
 'Please delete the next two lines after trial
 MsgBox "Ok proceding for Auto Filtering" & Choice
 Exit Sub

希望它会有用

将宏应用于另一个工作簿中的复制过来的工作表

1 个答案: