View Single Post
  #4   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

On Wednesday, November 21, 2012 3:59:48 AM UTC+10, frankjh19701 wrote:
I get an error at the Set main workbook - COMPILE ERROR: INVALID OUTSIDE

PROCEDURE"



I'm stuck :(Nathan Liebke;1607518 Wrote:

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










--

frankjh19701


Hmmm... I assume you changed the spreadsheet name to your location. Is the spreadsheet password protected?