Sub STEP7()
Dim Wb1 As Workbook
Dim wb3 As Workbook
Dim Ws1 As Worksheet
Dim ws3 As Worksheet
Dim strPath As String
Dim r As Long
Dim m As Long
Dim rng As Range
Dim n As Long
Application.ScreenUpdating = False
Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "1.xls")
Set Ws1 = Wb1.Worksheets(1)
m = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
strPath = ThisWorkbook.Path & ""
Set wb3 = Workbooks.Open(strPath & "BasketOrder..csv")
Set ws3 = wb3.Worksheets(1)
Set rng = ws3.Range("C:C").Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
If rng Is Nothing Then
n = 1
Else
n = rng.Row + 1
End If
For r = 2 To m
ws3.Range("C" & n).Value = Ws1.Range("B" & r).Value
n = n + 1
Next r
Application.DisplayAlerts = False
wb3.SaveAs FileName:=strPath & "BasketOrder..csv", FileFormat:=xlCSV
wb3.Close SaveChanges:=False
Wb1.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I have this macro which is working perfect but i converted the basketorder..csv to basketorder.xlsx so i need the modification according to that
Sub STEP7()
Dim Wb1 As Workbook
Dim wb3 As Workbook
Dim Ws1 As Worksheet
Dim ws3 As Worksheet
Dim r As Long
Dim m As Long
Dim rng As Range
Dim n As Long
Application.ScreenUpdating = False
Set Wb1 = Workbooks.Open("C:UsersWolfieeeStyleDesktop1.xls")
Set Ws1 = Wb1.Worksheets(1)
m = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
Set wb3 = Workbooks.Open("C:UsersWolfieeeStyleDesktopBasketOrder.xlsx")
Set ws3 = wb3.Worksheets(1)
Set rng = ws3.Range("C:C").Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
If rng Is Nothing Then
n = 1
Else
n = rng.Row + 1
End If
For r = 2 To m
ws3.Range("C" & n).Value = Ws1.Range("B" & r).Value
n = n + 1
Next r
Application.DisplayAlerts = False
wb3.Close SaveChanges:=True
Wb1.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am using this getting perfect output
Any more changes then plz let me know Sir
Thnx Alot HansV Sir & Leif Sir for helping me in solving this problem Sir
Have a Awesome Day
Last edited by zyxw1234 on 22 Jul 2020, 04:58, edited 1 time in total.