I have a large Excel worksheet with info sorted by date. The columns, from left to right, are "Date", "Origin", "Employee", "Vehicle #", "Product Count", and "Park Location."

What I'm looking for is a Macro to COPY the entire row from another workbook's "Main" sheet (on the server) based on "Vehicle #" and PASTE the row into a new worksheet in another workbook and name the new worksheet the "Vehicle #." Auto sort the data by date as well.

I've been using:


Sub Sorting()

Dim sh2 As Worksheet, finalrow As Long
Dim i As Long, lastrow As Long
Set sh2 = Sheets("160")
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If Cells(i, 1).Value = "160" Then
lastrow = sh2.Cells(Cells.Rows.Count, 1).End(xlUp).Row
Cells(i, 1).EntireRow.Copy Destination:=sh2.Cells(lastrow + 1, 1)

End If
Next i
End Sub

But this only works if I copy the "Main" sheet from the external workbook and paste it into the workbook I'm using. And I have to manually change the "Vehicle #."

Any/all assistance would be greatly appreciated.

Thank you

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

I get an error at the Set main workbook - COMPILE ERROR: INVALID OUTSIDE PROCEDURE"

I'm stuck :(

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?

No, it's not password protected. I tried saving it to the local Hard Drive (C) and I even saved the file from the server it has to reference to the local hard drive (C).

I'm new at macros and I want to get better. Any ideas on where and what to do next?

Frank

No, it's not password protected. I tried saving it to the local Hard Drive (C) and I even saved the file from the server it has to reference to the local hard drive (C).

I'm new at macros and I want to get better. Any ideas on where and what to do next?

Frank

On Tuesday, November 27, 2012 3:25:07 AM UTC+10, frankjh19701 wrote:
No, it's not password protected. I tried saving it to the local Hard

Drive (C) and I even saved the file from the server it has to reference

to the local hard drive (C).



I'm new at macros and I want to get better. Any ideas on where and what

to do next?



Frank



Nathan Liebke;1607537 Wrote:

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?









--

frankjh19701

Can you show me all of the code you have? Also, what version of Excel do you have?