cbulagner
11-22-2015, 02:43 AM
Hello Guys.
I'm currently having troubles with my vba code as we have shifted to excel 2010 from excel 2003.
I've searched many sites and still do not get how to make it work in the new excel.
I'm a noob in excel vba so please bear with me thanks.
Sub Igor2() Dim MyDir As String
Dim strPath As String
Dim vaFileName As Variant
Dim i As Integer
Dim a
Dim pivnumber
Dim x
Dim FoundRange As Range
Dim o
xlsfile = ThisWorkbook.Name
Windows(xlsfile).Activate
MyDir = "link" ' current path
strPath = MyDir & "" ' files subdir
last = Sheets("List to check").Range("B65536").End(xlUp).Row
'last = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For counter = 1 To last
Set Name = Worksheets("List to check").Cells(counter, 2)
Set pivnumber = Worksheets("List to check").Cells(counter, 1)
With Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = Name & "*" & ".xls"
If .Execute > 0 Then
For Each vaFileName In .FoundFiles
' open the workbook
Workbooks.Open vaFileName
' put "Hello" in A1 in each file
myname = ActiveWorkbook.Name
lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For o = 15 To lastrow
If Cells(o, 2).Value = pivnumber Then
curr = Cells(10, 10).Value
Line = o
ActiveSheet.Rows(Line).Select ' musis specifikovat range
Selection.Copy
Windows(xlsfile).Activate
Sheets("Total sheets").Activate
last = Worksheets("Total sheets").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Rows(last + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("U" & last + 1).Value = myname
Range("V" & last + 1).Value = curr
Windows(myname).Activate
Else
End If
Next o
Windows(myname).Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
Next
End If
End With
Next counter
End Sub
I'm currently having troubles with my vba code as we have shifted to excel 2010 from excel 2003.
I've searched many sites and still do not get how to make it work in the new excel.
I'm a noob in excel vba so please bear with me thanks.
Sub Igor2() Dim MyDir As String
Dim strPath As String
Dim vaFileName As Variant
Dim i As Integer
Dim a
Dim pivnumber
Dim x
Dim FoundRange As Range
Dim o
xlsfile = ThisWorkbook.Name
Windows(xlsfile).Activate
MyDir = "link" ' current path
strPath = MyDir & "" ' files subdir
last = Sheets("List to check").Range("B65536").End(xlUp).Row
'last = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For counter = 1 To last
Set Name = Worksheets("List to check").Cells(counter, 2)
Set pivnumber = Worksheets("List to check").Cells(counter, 1)
With Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = Name & "*" & ".xls"
If .Execute > 0 Then
For Each vaFileName In .FoundFiles
' open the workbook
Workbooks.Open vaFileName
' put "Hello" in A1 in each file
myname = ActiveWorkbook.Name
lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For o = 15 To lastrow
If Cells(o, 2).Value = pivnumber Then
curr = Cells(10, 10).Value
Line = o
ActiveSheet.Rows(Line).Select ' musis specifikovat range
Selection.Copy
Windows(xlsfile).Activate
Sheets("Total sheets").Activate
last = Worksheets("Total sheets").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Rows(last + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("U" & last + 1).Value = myname
Range("V" & last + 1).Value = curr
Windows(myname).Activate
Else
End If
Next o
Windows(myname).Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
Next
End If
End With
Next counter
End Sub