宏将数据从一个工作簿复制到另一个工作簿

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，我无法真正理解复制和粘贴范围，但我知道你在做什么，定义了复印纸的范围，在主表中选择了一个单元并粘贴它。 / p>

365个标签？我以为你每周都这样做？

您可以随时自行复制标签页（工作表），但看起来您将在单页主页上放置一周数据。

这是一个子（宏）中的框架工作，但我没有为每个工作表执行复制和粘贴到主工作表/工作簿中，但这会让你关闭，因为它向您展示如何获取文件，打开文件，然后一次遍历工作表1并对其执行任务。

我需要了解更多有关copysheet和master sheet的信息，以便进行详细的工作。我跳这会帮助你。我猜你的宏代码来自宏记录器，因为所有的选择。

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