Question

我正在尝试在一个文件夹中打开多个文件，转到每个标题为"OTC records"的电子表格中的特定工作表，并将所有数据复制到一个名为"OTC records"的标签页上。

我下面的宏似乎打开文件确定并堆叠数据，但仅用于文件中的第一张表。

我想我需要更改复制范围行[Set CopyRng = Wkb.Sheets(1)]以指向工作表名称，但我不知道该怎么做。我试图将其更改为指向工作表[通过将行更改为 - Set CopyRng = Wkb.Sheets("OTC records")]，但它根本不喜欢它。

有人可以帮忙吗？

Sub MergeFiles1()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer

RowofCopySheet = 2

ThisWB = ActiveWorkbook.Name

path = ("F:\WIN7PROFILE\Desktop\Recs")

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ActiveWorkbook.Sheets("OTC records")
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
        Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
        Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
        Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
        CopyRng.Copy Dest
        Wkb.Close False
    End If

    Filename = Dir()
Loop

Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"
End Sub

我已将代码更改为以下内容，但无法使循环工作。你能帮忙吗？

Sub MergeFiles1（） Dim path As String，ThisWB As String，lngFilecounter As Long Dim wbDest As Workbook，shtDest As Worksheet，ws As Worksheet Dim Filename As String，Wkb As Workbook Dim CopyRng作为范围，Dest作为范围 Dim RowofCopySheet As Integer

RowofCopySheet = 2

ThisWB = ActiveWorkbook.Name

path = ("F:\WIN7PROFILE\Desktop\Recs")

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ActiveWorkbook.Sheets("OTC records")
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
        Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
        WS_Count = ActiveWorkbook.Worksheets.Count
            For I = 1 To WS_Count
             if Wkb.Worksheets(I).Name = "OTC Records"
                 idx = I
    End If
 Next I
        Set CopyRng = Wkb.Sheets(idx).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
        Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
        CopyRng.Copy Dest
        Wkb.Close False
    End If

    Filename = Dir()
Loop

Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"

End Sub

Answer 1

尝试遍历另一个工作簿中的工作表以找到特定的工作表：

WS_Count = ActiveWorkbook.Worksheets.Count
     For I = 1 To WS_Count
        if Wkb.Worksheets(I).Name = "OTC Records"
              idx = I ' idx would hold index of the found sheet
        end if
     Next I

然后您可以通过

访问该工作表

Wkb.Sheets(idx)

信息来自：https://support.microsoft.com/en-us/kb/142126

选择复制范围

1 个答案: