View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Nathan Liebke Nathan Liebke is offline
external usenet poster
 
Posts: 5
Default Macro to copy row based on value into new sheet of same name

Something like this might get you started:

Dim MainWorkBook As Workbook
Dim MainSheet As Worksheet
Dim intRow As Integer
Dim intInsertRow As Integer
Dim VehicleNumber As String
Dim xls As Worksheet
Dim SheetFound As Boolean

' Open up your new workbook
Set MainWorkBook = Workbooks.Open("D:\Main.xls")
Set MainSheet = MainWorkBook.Sheets("Main")

' Loop through all rows (Ignore row 1)
For intRow = 2 To MainSheet.UsedRange.Rows.Count
VehicleNumber = MainSheet.Cells(intRow, 4)
If VehicleNumber < "" Then
SheetFound = False
' Look for the matching sheet in the current workbook
For Each xls In ThisWorkbook.Sheets
' If the names match, continue
If xls.Name = VehicleNumber Then
SheetFound = True
Exit For
End If
Next xls

' If the sheet isn't found, create a new one
If Not SheetFound Then
Set xls = ThisWorkbook.Sheets.Add
xls.Name = VehicleNumber
' Put headers in
xls.Cells(1, 1) = "Date"
End If

' Insert new row
intInsertRow = xls.Cells(Cells.Rows.Count, 1).End(xlUp).Row
MainSheet.Cells(intRow, 1).EntireRow.Copy Destination:=xls.Cells(intInsertRow + 1, 1)


End If
Next intRow

MainWorkBook.Close

' Sort sheets
For Each xls In ThisWorkbook.Sheets
If xls.UsedRange.Rows.Count 1 Then
xls.Unprotect
xls.UsedRange.Sort Key1:=xls.Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
Next xls