yalcinbican
New Member
- Joined
- Jan 25, 2016
- Messages
- 6
VBA Code:
Sub OpenWorkbook()
On Error Resume Next
Sheet4.ShowAllData
On Error GoTo 0
Dim FileToOpen As Variant
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename(Title:="Browse for Customer Balance excel file", filefilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
Workbooks(2).Worksheets(1).Range("A1:BU100000").Copy Workbooks(1).Worksheets(2).Range("A1")
Workbooks(2).Close SaveChanges:=True
End If
Workbooks(1).Worksheets(2).Range("A1").AutoFilter Field:=5, Criteria1:="*TOYOTA*"
Dim rBig As Range, r As Range, v As Variant
Set rBig = Range("F1:F30000")
For Each r In rBig
v = r.Value
If Not IsError(v) Then
If v <> "" And r.HasFormula = False Then
If IsNumeric(v) Then
r.Clear
r.Value = v
End If
End If
End If
Next r
Workbooks(1).Worksheets(4).Range("Q:Q").Copy
Workbooks(1).Worksheets(4).Range("S:S").PasteSpecial xlPasteValues
Workbooks(1).Worksheets(4).Columns("S:S").Select
Dim data As Variant, temp As Variant
Dim obj As Object
Dim i As Long
Set obj = CreateObject("scripting.dictionary")
data = Selection
For i = 1 To UBound(data)
obj(data(i, 1) & "") = ""
Next
temp = obj.keys
Selection.ClearContents
Selection(1, 1).Resize(obj.Count, 1) = Application.Transpose(temp)
Workbooks(1).Worksheets(4).Range("S2:S1000").Sort key1:=Range("S2:S1000"), _
order1:=xlAscending, Header:=xlNo
'Steve to help
Dim j As Integer
For j = 19 To 100
With Workbooks(1).Worksheets(4).Range("A:S")
.AutoFilter Field:=17, Criteria1:=Cells(2, j).Value
End With
Next j
'Steve to help
FileToOpen = Application.GetOpenFilename(Title:="Browse for template excel file", filefilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
RCount = Selection.Rows.Count
For i = RCount To 1 Step -2
Worksheets(3).Rows(i).EntireRow.Delete
Next i
Workbooks(1).Worksheets(4).Range("A1:R1000").Copy
Workbooks(2).Worksheets(3).Range("A1").PasteSpecial Paste:=xlPasteValues
Workbooks(1).Worksheets(4).ShowAllData
Dim MyPath As String, MyRange1 As Range, MyRange2 As Range
MyPath = ThisWorkbook.Path
Set MyRange1 = Workbooks(2).Worksheets(1).Range("D17")
Set MyRange2 = Workbooks(2).Worksheets(1).Range("E17")
Workbooks(2).Worksheets(1).Range("D11").Value = Workbooks(2).Worksheets(3).Range("A2").Value
Range("B5").Select
Cells.Replace What:="L1", Replacement:="L2", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
, FormulaVersion:=xlReplaceFormula2
Workbooks(2).SaveAs Filename:=MyPath & "\" & MyRange1.Value & " - " & MyRange2.Value & ".xlsx"
Workbooks(2).Close SaveChanges:=True
'Workbooks(1).Close SaveChanges:=True
End If
End Sub