选择一个用于复制范围的特定标签

Question

I am trying to open several files in one folder, go to a specific sheet in each spreadsheet entitled "OTC records" and copy all that data onto one tab called "OTC records" .

The macro I have below seems to open the files ok and stack the data but only for the first sheet in the files.

I think I need to change the copy range line [Set CopyRng = Wkb.Sheets(1)] to point to a sheet name but I don't know how to do that. I tried to change this to point to the sheet [by changing the line to - Set CopyRng = Wkb.Sheets("OTC records") ] but it is not loving it at all.

Can anyone please help?

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

I've change the code to the below but am not able to get the looping to work. Would you be able to help?

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

Try to loop through sheets in another workbook to find specific one:

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

Then you can access that worksheet by

Wkb.Sheets(idx)

Information taken from: https://support.microsoft.com/en-us/kb/142126