Good Morning All,
I am wondering if it is possible to take the code below and add a next step. In this step i want to take the data from sheet 2 (Tab 2) and split it into two additional tabs called "s breaks" and "c breaks".
So, if the cells in column "N" contain "Working with Client" or "Expecting Transaction on Overnight Feed" they should be placed in the "c breaks tab" and everything else should go into the "s break tab".
Sub Copy()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "C:\Users\woswald\Documents\Castlelake"
Filepath = FolderPath & "*.xls*"
Filename = Dir(Filepath)
Dim erow As Long, lastrow As Long, lastcolumn As Long
Do While Filename <> ""
If Filename <> "Investran_Consolidated.xlsm" Then
Dim wb As Workbook
Set wb = Workbooks.Open(FolderPath & Filename)
For counter = 1 To 2
'Sheets("Sheet1").Select
wb.Worksheets(counter).Activate
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
'Sheets("Sheet1").Select
Workbooks("Investran_Consolidated.xlsm").Worksheets(counter).Activate
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Select
ActivateSheet.Paste
Next counter
Application.CutCopyMode = False
wb.Close False
Filename = Dir()
End If
Loop
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Select
End Sub
I am wondering if it is possible to take the code below and add a next step. In this step i want to take the data from sheet 2 (Tab 2) and split it into two additional tabs called "s breaks" and "c breaks".
So, if the cells in column "N" contain "Working with Client" or "Expecting Transaction on Overnight Feed" they should be placed in the "c breaks tab" and everything else should go into the "s break tab".
Sub Copy()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "C:\Users\woswald\Documents\Castlelake"
Filepath = FolderPath & "*.xls*"
Filename = Dir(Filepath)
Dim erow As Long, lastrow As Long, lastcolumn As Long
Do While Filename <> ""
If Filename <> "Investran_Consolidated.xlsm" Then
Dim wb As Workbook
Set wb = Workbooks.Open(FolderPath & Filename)
For counter = 1 To 2
'Sheets("Sheet1").Select
wb.Worksheets(counter).Activate
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
'Sheets("Sheet1").Select
Workbooks("Investran_Consolidated.xlsm").Worksheets(counter).Activate
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Select
ActivateSheet.Paste
Next counter
Application.CutCopyMode = False
wb.Close False
Filename = Dir()
End If
Loop
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Select
End Sub
Last edited: