Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move Data
Hi folks,
I need a help on Excel macro. I have a spreadsheet which called sheet1 and has thousands of records and group by departments. I want to create a macro which can move the same departments records to the new sheet and rename the sheet to the department name. Could anyone show me the code? Any help will be appreciated? Thanks in advance. Tim. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move Data
Try:
http://www.rondebruin.nl/copy5.htm#all Hope this helps Rowan Tim wrote: Hi folks, I need a help on Excel macro. I have a spreadsheet which called sheet1 and has thousands of records and group by departments. I want to create a macro which can move the same departments records to the new sheet and rename the sheet to the department name. Could anyone show me the code? Any help will be appreciated? Thanks in advance. Tim. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move Data
keeping it really simple
Option Explicit Sub test() CopyRows "x" End Sub Sub CopyRows(dept As String) Dim targetIndex As Long Dim sourceIndex As Long Dim targetSheet As Worksheet Dim sourceSheet As Worksheet Set sourceSheet = Worksheets("sheet1") Set targetSheet = GetSheet(dept) Application.ScreenUpdating = False For sourceIndex = 1 To sourceSheet.Range("A65000").End(xlUp).Row If sourceSheet.Cells(sourceIndex, 1).Value = dept Then targetIndex = targetIndex + 1 targetSheet.Rows(targetIndex).Value = _ sourceSheet.Rows(sourceIndex).Value End If Next Application.ScreenUpdating = True End Sub Function GetSheet(sheetsname As String) As Worksheet On Error Resume Next Set GetSheet = Worksheets(sheetsname) If Err.Number = 0 Then GetSheet.Cells.Clear Else Set GetSheet = Worksheets.Add GetSheet.Name = sheetsname End If On Error GoTo 0 End Function this should be easy enough. screen updating speeds things up quite a bit we simple check each row to see if the cell in A matches teh dept, then we copy it. we keep a record of which is the nest row to update. Its probably faster to use 'FIND' so I'll add that routine in my next mail shortly "Tim" wrote: Hi folks, I need a help on Excel macro. I have a spreadsheet which called sheet1 and has thousands of records and group by departments. I want to create a macro which can move the same departments records to the new sheet and rename the sheet to the department name. Could anyone show me the code? Any help will be appreciated? Thanks in advance. Tim. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move Data
using FIND for speeier execution
Option Explicit Sub test() CopyRows "x" End Sub Sub CopyRows(dept As String) Dim targetIndex As Long Dim sourceIndex As Long Dim targetSheet As Worksheet Dim sourceSheet As Worksheet Dim found As Range Dim firstaddress As String Set sourceSheet = Worksheets("sheet1") Set targetSheet = GetSheet(dept) Application.ScreenUpdating = False Set found = sourceSheet.Range("A:A").Find(dept) If Not found Is Nothing Then firstaddress = found.Address Do targetIndex = targetIndex + 1 sourceIndex = found.Row targetSheet.Rows(targetIndex).Value = _ sourceSheet.Rows(sourceIndex).Value Set found = sourceSheet.Range("A:A").FindNext(found) Loop Until firstaddress = found.Address End If Application.ScreenUpdating = True End Sub Function GetSheet(sheetsname As String) As Worksheet On Error Resume Next Set GetSheet = Worksheets(sheetsname) If Err.Number = 0 Then GetSheet.Cells.Clear Else Set GetSheet = Worksheets.Add GetSheet.Name = sheetsname End If On Error GoTo 0 End Function "Patrick Molloy" wrote: keeping it really simple Option Explicit Sub test() CopyRows "x" End Sub Sub CopyRows(dept As String) Dim targetIndex As Long Dim sourceIndex As Long Dim targetSheet As Worksheet Dim sourceSheet As Worksheet Set sourceSheet = Worksheets("sheet1") Set targetSheet = GetSheet(dept) Application.ScreenUpdating = False For sourceIndex = 1 To sourceSheet.Range("A65000").End(xlUp).Row If sourceSheet.Cells(sourceIndex, 1).Value = dept Then targetIndex = targetIndex + 1 targetSheet.Rows(targetIndex).Value = _ sourceSheet.Rows(sourceIndex).Value End If Next Application.ScreenUpdating = True End Sub Function GetSheet(sheetsname As String) As Worksheet On Error Resume Next Set GetSheet = Worksheets(sheetsname) If Err.Number = 0 Then GetSheet.Cells.Clear Else Set GetSheet = Worksheets.Add GetSheet.Name = sheetsname End If On Error GoTo 0 End Function this should be easy enough. screen updating speeds things up quite a bit we simple check each row to see if the cell in A matches teh dept, then we copy it. we keep a record of which is the nest row to update. Its probably faster to use 'FIND' so I'll add that routine in my next mail shortly "Tim" wrote: Hi folks, I need a help on Excel macro. I have a spreadsheet which called sheet1 and has thousands of records and group by departments. I want to create a macro which can move the same departments records to the new sheet and rename the sheet to the department name. Could anyone show me the code? Any help will be appreciated? Thanks in advance. Tim. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Move Data
Patrick and Rowan,
Thank you very much for your help and time. The solutions work great. Tim. "Patrick Molloy" wrote: using FIND for speeier execution Option Explicit Sub test() CopyRows "x" End Sub Sub CopyRows(dept As String) Dim targetIndex As Long Dim sourceIndex As Long Dim targetSheet As Worksheet Dim sourceSheet As Worksheet Dim found As Range Dim firstaddress As String Set sourceSheet = Worksheets("sheet1") Set targetSheet = GetSheet(dept) Application.ScreenUpdating = False Set found = sourceSheet.Range("A:A").Find(dept) If Not found Is Nothing Then firstaddress = found.Address Do targetIndex = targetIndex + 1 sourceIndex = found.Row targetSheet.Rows(targetIndex).Value = _ sourceSheet.Rows(sourceIndex).Value Set found = sourceSheet.Range("A:A").FindNext(found) Loop Until firstaddress = found.Address End If Application.ScreenUpdating = True End Sub Function GetSheet(sheetsname As String) As Worksheet On Error Resume Next Set GetSheet = Worksheets(sheetsname) If Err.Number = 0 Then GetSheet.Cells.Clear Else Set GetSheet = Worksheets.Add GetSheet.Name = sheetsname End If On Error GoTo 0 End Function "Patrick Molloy" wrote: keeping it really simple Option Explicit Sub test() CopyRows "x" End Sub Sub CopyRows(dept As String) Dim targetIndex As Long Dim sourceIndex As Long Dim targetSheet As Worksheet Dim sourceSheet As Worksheet Set sourceSheet = Worksheets("sheet1") Set targetSheet = GetSheet(dept) Application.ScreenUpdating = False For sourceIndex = 1 To sourceSheet.Range("A65000").End(xlUp).Row If sourceSheet.Cells(sourceIndex, 1).Value = dept Then targetIndex = targetIndex + 1 targetSheet.Rows(targetIndex).Value = _ sourceSheet.Rows(sourceIndex).Value End If Next Application.ScreenUpdating = True End Sub Function GetSheet(sheetsname As String) As Worksheet On Error Resume Next Set GetSheet = Worksheets(sheetsname) If Err.Number = 0 Then GetSheet.Cells.Clear Else Set GetSheet = Worksheets.Add GetSheet.Name = sheetsname End If On Error GoTo 0 End Function this should be easy enough. screen updating speeds things up quite a bit we simple check each row to see if the cell in A matches teh dept, then we copy it. we keep a record of which is the nest row to update. Its probably faster to use 'FIND' so I'll add that routine in my next mail shortly "Tim" wrote: Hi folks, I need a help on Excel macro. I have a spreadsheet which called sheet1 and has thousands of records and group by departments. I want to create a macro which can move the same departments records to the new sheet and rename the sheet to the department name. Could anyone show me the code? Any help will be appreciated? Thanks in advance. Tim. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Move data | Excel Worksheet Functions | |||
Move data? | Setting up and Configuration of Excel | |||
Macro to move data to different column based on data in another co | Excel Discussion (Misc queries) | |||
enter data in cell which will start macro to move data to sheet2 | Excel Discussion (Misc queries) | |||
create macro to move label type data to column data | Excel Programming |