將宏應用於另一個工作簿中復制的工作表

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的評論。 但是，如果您無法控制下載的數據，則該代碼將為您提供一些解決方法。 添加僅在宏開始處給出的代碼，它將檢查表“ 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

希望它會有用