ganganana99
New Member
- Joined
- Jul 24, 2018
- Messages
- 1
I have a workbook with multiple worksheets - sales of different companies for different months. The worksheets have the same columns. Different number of rows 1000 - 60,0000
I am attempting to copy data from these worksheets to multiple other files(each having a single worksheet- one company in one file). The name of company is in column D of source worksheets. The destination file names should be what's in column D of source row.
criteria to copy is that Column U = '>=57 days' and Column S is blank
I have done part of the code as below but need help to extend this to do the other things that need to be done
Sub Copy_Rows_With_57_Days()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Dim Lastrowa As Long
Sheets(1).Activate
Lastrow = Cells(Rows.Count, "F").End(xlUp).Row
Lastrowa = Sheets(2).Cells(Rows.Count, "F").End(xlUp).Row + 1
For i = 1 To Lastrow
If IsEmpty(Cells(i, 19)) And Cells(i, 21).Value = ">=57 days" Then
Rows(i).Copy Destination:=Sheets(2).Rows(Lastrowa)
Lastrowa = Lastrowa + 1
End If
Next
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub
Any help would be much appreciated!
Ganga
I am attempting to copy data from these worksheets to multiple other files(each having a single worksheet- one company in one file). The name of company is in column D of source worksheets. The destination file names should be what's in column D of source row.
criteria to copy is that Column U = '>=57 days' and Column S is blank
I have done part of the code as below but need help to extend this to do the other things that need to be done
Sub Copy_Rows_With_57_Days()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Dim Lastrowa As Long
Sheets(1).Activate
Lastrow = Cells(Rows.Count, "F").End(xlUp).Row
Lastrowa = Sheets(2).Cells(Rows.Count, "F").End(xlUp).Row + 1
For i = 1 To Lastrow
If IsEmpty(Cells(i, 19)) And Cells(i, 21).Value = ">=57 days" Then
Rows(i).Copy Destination:=Sheets(2).Rows(Lastrowa)
Lastrowa = Lastrowa + 1
End If
Next
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub
Any help would be much appreciated!
Ganga