简体   繁体   English

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

[英]Applying Macro to Copied Over Worksheet from another Workbook

Situation: Every month I need to take a source of data and re-format it so I can dump it into another file and update a pivot table. 情况:每个月我都需要获取数据源并重新格式化,以便可以将其转储到另一个文件中并更新数据透视表。 I want to automate the reformatting piece however I can't quite figure out the best way. 我想使重新格式化的文件自动化,但是我还不太清楚最佳方法。 Ideally, I would download the data source from online, copy the workbook to this Automated Workbook and run the macro. 理想情况下,我将在线下载数据源,将工作簿复制到此“自动化工作簿”并运行宏。 So I've recorded the Macro I need. 因此,我已经记录了所需的宏。 See below for reference however now when I try to run to the copied over worksheet I get an "out of range" error. 请参阅下面的参考,但是现在当我尝试运行复制到工作表上方时,出现“超出范围”错误。 I'm guessing I need something that will allow me to run the Macro on this copied over sheet or all sheets of the workbook? 我想我需要一些可以让我在工作簿的工作表或所有工作表上复制的宏运行宏吗?

Current Code: 当前代码:

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 

This is not an answer but an add on to catch & smoother the problem. 这不是一个答案,而是一个附加功能,可以解决并解决问题。 The real problem is what @Lambik commented. 真正的问题是@Lambik的评论。 However if you have no control over the downloaded data the code will give you some ways to tackle it. 但是,如果您无法控制下载的数据,则该代码将为您提供一些解决方法。 Add the code given just at the starting of Macro, it will check for existence of table "Combine3" and offer you some alternatives 添加仅在宏开始处给出的代码,它将检查表“ 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

Hope it will be useful 希望它会有用

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM