Question

我有一个Master excel（合并跟踪器），每周我们在其中添加源文件中的数据。

合并的跟踪器和源文件具有3个标签（未结头寸，已平仓，已取消）

每个星期我都会将数据从源文件（从每个选项卡）放到合并文件（到每个选项卡）例如：源文件中的未平仓头寸数据转到Consolidated Tracker中的未平仓头寸，依此类推。

我正在使用以下代码，但面临以下问题：

1）我必须提供文件的全名。例如。 Worbooks。（“来源*”）   不管用。有没有办法只给出部分名称，因为   每次我的文件名末尾都有日期，因此我想给   *。

2）不是ActiveWorkbook.Sheets（I）或ActiveWorkbook.Sheets（“ Name”）   工作。它总是用于打开工作表/标签。

3）粘贴正在粘贴输出并给出以下错误。”方法   对象范围的PasteSpecial失败”

4）Selection.EntireRow.Delete ..有时会出现错误，有时会   不会删除，而是再次进入For循环。   5）此外，似乎循环不起作用。因为它没有占用下一个标签。

这是代码。

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

VBA中的多个问题

1 个答案: