I want to open a file and then interogate it to see if it contains data i need. If i find it I want to create a file to export the data there. I have 4 workbooks that i need to create. The source workbook has one sheet, and the portalworkbooks also. The source worksheet has a lot of line and columns but what i need to search i know it is in the column 4. So all i need to do is compare cell(i,4) = data i want and then export it to the specific file. I have to go trough all the source worksheet. It gives me and error 9. out of range Pls help. I'm doing something wrong manipulating objects in here. Thanks in advance
------------------------------------------------------------------------
Sub Deschide()
Dim portalwkb1, portalwkb2, portalwkb3, portalwkb4 As Workbook, sourcewkb As Workbook
Dim Ret1, Ret2
Dim srcws As Worksheet ' Variable for source workbook worksheets
Dim portalws1, portalws2, portalws3, portalws4 As Worksheet ' Variable for portal workbook worksheets
Dim srcLR, i, j, k, l, m As Long ' last row of the source worksheet
Const Coloana As Long = 4
Dim rng As Range
Set portalwkb1 = Workbooks.Add
With portalwkb1
.SaveAs Filename:="N.xls"
End With
Set portalwkb2 = Workbooks.Add
With portalwkb2
.SaveAs Filename:="C.xls"
End With
Set portalwkb3 = Workbooks.Add
With portalwkb3
.SaveAs Filename:="I.xls"
End With
Set portalwkb4 = Workbooks.Add
With portalwkb4
.SaveAs Filename:="L.xls"
End With
'~~> Get the first File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select the source file file")
If Ret1 = False Then
' Tell the user why the code has been terminated
MsgBox ("Nu ai ales nici un fisier! Rutina se va termina!")
End
End If
' Open the Source file
Set sourcewkb = Workbooks.Open(Ret1)
' Set the source worksheet
Set srcws = sourcewkb.Sheets(1)
' Set the first destination worksheet
Set portalws1 = portalwkb1.Sheets(1)
Set portalws2 = portalwkb2.Sheets(1)
Set portalws3 = portalwkb3.Sheets(1)
Set portalws4 = portalwkb4.Sheets(1)
k = 1
l = 1
j = 1
m = 1
'Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").Value = _
' Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value
'Find the last row of data in the Source worksheet
srcLR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To srcLR
If srcws.Cells(i, Coloana) = "data to compare" Then
portalws1.Range("A[j]:A[100]") = srcws.Range("A:A[100]").Value
j = j + 1
ElseIf srcws.Cells(i, Coloana) = "data to compare" Then
Set portalws2 = portalwkb2.Sheets(1)
portalws2.Range("A[k]").Value = sourcewkb.Worksheets("Sheet1").Range("A").Value
k = k + 1
ElseIf srcws.Cells(i, Coloana) = "data to compare" Then
portalws3.Range("A[l]:A[100]") = srcws.Range("A:A[100]").Value
l = l + 1
ElseIf srcws.Cells(i, Coloana) = "data to compare" Then
portalws4.Range("A[m]:A[100]") = srcws.Range("A:A[100]").Value
m = m + 1
End If
Next i
' close the source workbook, don't save any changes
sourcewkb.Close SaveChanges:=False
portalwkb1.Close SaveChanges:=True
portalwkb2.Close SaveChanges:=True
portalwkb3.Close SaveChanges:=True
portalwkb4.Close SaveChanges:=True
' Clear the objects
Set srcws = Nothing
Set sourcewkb = Nothing
Set portalws1 = Nothing
Set portalws2 = Nothing
Set portalws3 = Nothing
Set portalws4 = Nothing
Set portalwkb1 = Nothing
Set portalwkb2 = Nothing
Set portalwkb3 = Nothing
Set portalwkb4 = Nothing
End Sub
------------------------------------------------------------------------
Sub Deschide()
Dim portalwkb1, portalwkb2, portalwkb3, portalwkb4 As Workbook, sourcewkb As Workbook
Dim Ret1, Ret2
Dim srcws As Worksheet ' Variable for source workbook worksheets
Dim portalws1, portalws2, portalws3, portalws4 As Worksheet ' Variable for portal workbook worksheets
Dim srcLR, i, j, k, l, m As Long ' last row of the source worksheet
Const Coloana As Long = 4
Dim rng As Range
Set portalwkb1 = Workbooks.Add
With portalwkb1
.SaveAs Filename:="N.xls"
End With
Set portalwkb2 = Workbooks.Add
With portalwkb2
.SaveAs Filename:="C.xls"
End With
Set portalwkb3 = Workbooks.Add
With portalwkb3
.SaveAs Filename:="I.xls"
End With
Set portalwkb4 = Workbooks.Add
With portalwkb4
.SaveAs Filename:="L.xls"
End With
'~~> Get the first File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select the source file file")
If Ret1 = False Then
' Tell the user why the code has been terminated
MsgBox ("Nu ai ales nici un fisier! Rutina se va termina!")
End
End If
' Open the Source file
Set sourcewkb = Workbooks.Open(Ret1)
' Set the source worksheet
Set srcws = sourcewkb.Sheets(1)
' Set the first destination worksheet
Set portalws1 = portalwkb1.Sheets(1)
Set portalws2 = portalwkb2.Sheets(1)
Set portalws3 = portalwkb3.Sheets(1)
Set portalws4 = portalwkb4.Sheets(1)
k = 1
l = 1
j = 1
m = 1
'Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").Value = _
' Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value
'Find the last row of data in the Source worksheet
srcLR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To srcLR
If srcws.Cells(i, Coloana) = "data to compare" Then
portalws1.Range("A[j]:A[100]") = srcws.Range("A:A[100]").Value
j = j + 1
ElseIf srcws.Cells(i, Coloana) = "data to compare" Then
Set portalws2 = portalwkb2.Sheets(1)
portalws2.Range("A[k]").Value = sourcewkb.Worksheets("Sheet1").Range("A").Value
k = k + 1
ElseIf srcws.Cells(i, Coloana) = "data to compare" Then
portalws3.Range("A[l]:A[100]") = srcws.Range("A:A[100]").Value
l = l + 1
ElseIf srcws.Cells(i, Coloana) = "data to compare" Then
portalws4.Range("A[m]:A[100]") = srcws.Range("A:A[100]").Value
m = m + 1
End If
Next i
' close the source workbook, don't save any changes
sourcewkb.Close SaveChanges:=False
portalwkb1.Close SaveChanges:=True
portalwkb2.Close SaveChanges:=True
portalwkb3.Close SaveChanges:=True
portalwkb4.Close SaveChanges:=True
' Clear the objects
Set srcws = Nothing
Set sourcewkb = Nothing
Set portalws1 = Nothing
Set portalws2 = Nothing
Set portalws3 = Nothing
Set portalws4 = Nothing
Set portalwkb1 = Nothing
Set portalwkb2 = Nothing
Set portalwkb3 = Nothing
Set portalwkb4 = Nothing
End Sub