宏可將數據從一個工作簿復制到另一個工作簿

Question

我正在嘗試創建一個宏，該宏會將數據從每周更新的其他工作簿中提取到“主工作簿”中。

我遇到的問題是，我每周收到的文件總是以不同的方式命名（在結束時更新），工作簿中的8個選項卡中的7個也以不同的方式命名（在該周中適用於一周中的每一天）結束范圍）。

如果它是一個靜態文件名，則該宏很容易實現。 我已經在許多論壇上閱讀了很多有關如何將其設置為宏以查看ACTIVE工作簿的方法，而不是專門命名的工作簿，但是我似乎無法使它起作用。

下面是我的專門名稱文件的宏； 我需要做些什么以使我可以通過每周打開並激活它來在每周收到的文件上運行它？

Sub SecData()
'
' SecData Macro
' Macro to move security badge-in data from weekly file to Master Security Log workbook.  Will overwrite Sheet1
'

'
    Sheets("Sheet1").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Range("A2").Select
    Windows("Framingham counts for the week ending 06-02-18.xlsx").Activate
    Sheets("05-27").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Windows("Master Security Logs.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A13").Select
    Windows("Framingham counts for the week ending 06-02-18.xlsx").Activate
    Sheets("05-28").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Master Security Logs.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=18
    Range("A32").Select
    Windows("Framingham counts for the week ending 06-02-18.xlsx").Activate
    Sheets("05-29").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Master Security Logs.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D32").Select
    Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=18
    Range("A2154").Select
    Windows("Framingham counts for the week ending 06-02-18.xlsx").Activate
    Sheets("05-30").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Master Security Logs.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D2154").Select
    Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=9
    Range("A4378").Select
    Windows("Framingham counts for the week ending 06-02-18.xlsx").Activate
    Sheets("05-31").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Master Security Logs.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D4378").Select
    Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=12
    Range("A6638").Select
    Windows("Framingham counts for the week ending 06-02-18.xlsx").Activate
    Sheets("06-01").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Master Security Logs.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D6638").Select
    Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=18
    Range("A8435").Select
    Windows("Framingham counts for the week ending 06-02-18.xlsx").Activate
    Sheets("06-02").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Master Security Logs.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollRow = 7397
    ActiveWindow.ScrollRow = 2466
    ActiveWindow.ScrollRow = 1
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Answer 1

@Lacey LaDue，我真的不能很好地理解復制和粘貼范圍，但是我知道您在做什么，定義復制表的范圍，在主表中選擇一個單元格並將其粘貼。

365個標簽？ 我以為你每周都在做？

您始終可以自己復制選項卡（工作表），但是看起來您正在將一個星期的數據放在單個主表頁面上。

這是一個子框架（宏）中的框架，但是我沒有執行每個工作表的復制和粘貼到主工作表/工作簿中的操作，但這使您關閉，因為它顯示了如何獲取文件，打開文件並然后一次瀏覽工作表1並對其執行任務。

我需要更多地了解電子表格和母版紙才能進行詳細工作。 我希望這可以幫助您。 我猜您的宏代碼是由於所有選擇而來自宏記錄器的。

Option Explicit

'Sub to get the Current urFileName
Private Sub getFN()

    Dim Finfo As String
    Dim FilterIndex As Long
    Dim Title As String

    Dim CopyBook As Workbook    'Workbook to copy from
    Dim CopySheet As Worksheet  'Worksheet to copy from
    Dim FN As Variant           'File Name
    Dim wsNum As Double         'worksheet # as you move through the Copy Book
    Dim cwsLastRow As Long      'copy worksheet last row
    Dim mwsLastRow As Long      'master worksheet last row
    Dim masterWS As Worksheet   'thisworkbook, your master worksheet

    Set masterWS = ThisWorkbook.Worksheets("Master Security Logs")

    'Set up file filter
    Finfo = "Excel Files (*.xls*),*.xls*"
    'Set filter index to Excel Files by default in case more are added
    FilterIndex = 1
    ' set Caption for dialogue box
    Title = "Select the Current AP Reconcile Workbook"

    'get the Forecast Filename
    FN = Application.GetOpenFilename(Finfo, FilterIndex, Title)

    'Handle file Selection
    If FN = False Then
        MsgBox "No file was selected.", vbExclamation, "Not so fast"
    Else
        'Do your Macro tasks here
        'Supress Screen Updating but don't so this until you know your code runs well
        Application.ScreenUpdating = False

        'Open the AP File
        Workbooks.Open (FN)
        'Hide the file so it is out of the way
        Set CopyBook = ActiveWorkbook

        For wsNum = 1 To CopyBook.Sheets.Count 'you stated there will be 8, this is safer
            'Do your work here, looks like you are copying certain ranges from wach sheet into ThisWorkbook
            CopySheet = CopyBook.Worksheets(wsNum) '1,2,3,4,5,6,7,8

            'Finds the lastRow in your Copysheet each time through
            cwsLastRow = CopySheet.Cells(CopySheet.Rows.Count, "A").End(xlUp).Row

            'so you would have to keep tabs on what the lastRow of this sheet is too and always start at +1
            mwsLastRow = masterWS.Cells(masterWS.Rows.Count, "A").End(xlUp).Row

            'Do some copy and pasting between copySheet and masterWS based on your ranges
            'It looks like you copy data from each ws into your single master book worksheet

            'Clear the clipboard before you go around again
            Application.CutCopyMode = False
        Next wsNum
    End If

    'Close the workbook opened for the copy
    CopyBook.Close savechanges:=False 'Not needed now

    'Screen Updating Back on
    Application.ScreenUpdating = True

End Sub