Reputation: 11
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
Upvotes: 1
Views: 715
Reputation: 1384
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
Upvotes: 1