Question

我正在创建一个工作簿，该工作簿将用作月度报告的模板（我们将其称为“ ReportWorkbookTest”），并且正在努力编写或记录一个宏，该宏会将来自各种未指定工作簿的数据粘贴到ReportWorkbookTest中。

要创建月度报告，数据将从服务器导出到以报告的导出日期/时间命名的.xlsx文件。因此，将粘贴信息的工作簿的名称将始终具有不同的名称。每月数据导出中的信息列将始终保持不变（列D：G＆I）。我已经设法为两个指定的工作簿执行此操作，但是无法转换为新的每月数据导出。

    Range("I4").Select
Windows("Export 2018-06-21 11.51.34.xlsx").Activate
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
    xlFilterLastMonth, Operator:=xlFilterDynamic
Range("D2:G830,I2:I830").Select
Range("I2").Activate
Selection.Copy
Windows("ReportWorkbookTest.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

是否可以设置VBA，以便在运行宏时无需指定工作簿名称？另外，如果每次导出的行数发生变化，我如何指定宏仅复制表中的活动行？

谢谢！

Answer 1

这是您的框架，如果要导入多个文件，则建议使用向导。

向导框架将是： 1）提示用户选择一个文件（您可能要检查的某种类型，可以是列名-标头） 2）如果通过验证，则导入数据（并处理） 2b）如果未通过报告，则它不是有效文件，并再次提示 3）提示输入下一个文件类型 ......

我有一个像这样的项目，每个月需要进行4个不同的数据“转储”，并将它们合并到摘要工作簿中。

但是对于更改名称的单个文件，这里需要一个框架：如果只有一个工作表，则可以消除循环工作您可能也不会将数据追加到已经存在的数据上，但这就是查找新的最后一行的目的。

Option Explicit

'Sub to get the Current FileName
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

    Dim rngCopy1 As Range
    Dim rngCopy2 As Range

    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 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 each 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

            'Set your copy ranges
            Set rngCopy1 = CopySheet("D2:D"&cwsLastRow) 'this is your D column
            Set rngCopy2 = CopySheet("I2:I"&cwsLastRow) 'this is your I column

            '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

            'Copy the ranges in where you want them on the master sheet
            'rngCopy1.Copy destination:= masterWS.Range("D"&mwsLastRow+1)
            'rngCopy2.Copy destination:= masterWS.Range("I"&mwsLastRow+1)

            '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

Answer 2

如果仅打开这两个工作簿，则可以使用数字代替名称：

Workbooks(1)
and
Workbooks(2)

Workbooks（1）是第一个打开的宏，很有可能是该宏所在的ReportWorkbookTest.xlsm，因此您可以提供有关该文件首先打开的说明。如果将打开两个以上的工作簿，则可以尝试使用循环方法，这是一个使用示例：

Dim wkb as Workbook
Dim thisWb as Workbook
Dim expWb as Workbook
Set thisWb = ThisWorkbook
For Each wkb in Workbooks
    If wkb.Name Like "Export 2018-*" Then
        expWb = wkb
        Exit For
    End If
Next
If Not expWb Is Nothing Then
    'Found Export, do stuff like copy from expWb to thisWb
    expWb.Worksheets(1).Range("B20:B40").Copy
    thisWb.Sheets("PasteSheet").Range("A3").PasteSpecial xlValues
Else
    'Workbook with Export name not found
End If

VBA可以在不指定工作簿名称的情况下将数据粘贴到现有工作簿中？

2 个答案: