将数据从动态命名的源文件复制到主文件

Question

我有一个主工作簿 (Consolidate Tracker)，我们在其中添加来自源文件的数据。

综合跟踪器和源文件具有三个选项卡（未结头寸、已关闭、已取消）。

每周我都会将源文件（每个选项卡）中的数据放入合并文件（每个选项卡）。
例如：源文件中的未平仓头寸数据转到 Consolidated Tracker 中的未平仓头寸等。

我面临以下问题：

1. 我必须提供文件的全名。
   例如。 Workbooks("Source*") 不工作。
   有没有办法只给出部分名称？
   我的文件名最后会有一个日期。因此我想给*。

2. ActiveWorkbook.Sheets(I) 或 ActiveWorkbook.Sheets("Name") 始终用于打开工作表/选项卡。

3. 粘贴输出会出现以下错误。

对象范围的方法 PasteSpecial 失败

4. Selection.EntireRow.Delete 有时会出错或有时 不删除并再次进入 For 循环。

另外，循环似乎没有占用下一个标签。

Sub GetSheets()
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("D:\2018\ VBA\Consolidated Tracker.xlsm")
    Workbooks("Source_Tracker.xlsx").Activate
    For I = 1 To 3
        Set Sheet = ActiveWorkbook.Sheets(I)
        Columns("A:A").Select
        Selection.Insert Shift:=xlToRight
        Range("A1").Select
        Dim LastRow As Long
        LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        With Range("A1:A" & LastRow)
            .Value = Date
            .NumberFormat = "mm/dd/yy"
        End With

        Range("A1").Select
        ActiveCell.Offset(1, 0).Select
        Selection.CurrentRegion.Copy
        Workbooks("Consolidated Tracker").Activate
        Set Sheet = Workbooks("Consolidated Tracker.xlsm").Sheets(I)
        Range("A100000").Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        ActiveCell.PasteSpecial 
        ActiveCell.Offset(0, 0).Select
        Selection.EntireRow.Delete
    Next I
End Sub

Answer 1

考虑重写。

Option Explicit

Sub GetSheets()
    Dim i As Long, lr As Long
    Dim wb1 As Workbook, wb1 As Workbook

    Application.Workbooks.Open Filename:="D:\2018\ VBA\Consolidated Tracker.xlsm", _
                               ReadOnly:=True, AddToMru:=False

    setWbs wb1, wb2

    With wb1
        For i = 1 To 3
            With .Worksheets(i)
                .Columns("A:A").Insert Shift:=xlToRight
                lr = Cells.Find(what:="*", after:=.Cells(1), _
                                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                With .Range(.Cells(1, "A"), .Cells(lr, "A"))
                    .Value = Date
                    .NumberFormat = "mm/dd/yy"
                End With
                .Cells(1, "A").CurrentRegion.offset(1, 0).Copy _
                    Destination:=wb2.Worksheets(i).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End With
        Next i
    End With
End Sub

Sub setWbs(ByRef wkbk1 As Workbook, ByRef wkbk2 As Workbook)
    Dim wb As Long

    For wb = 1 To application.Workbooks.Count
        Select Case left(LCase(Workbooks(wb).name), 7)
            Case "source_"
                Set wkbk1 = Workbooks(wb)
            Case "consoli"
                Set wkbk2 = Workbooks(wb)
        End Select
    Next wb
End Sub