PC Review


Reply
Thread Tools Rate Thread

Cut/Paste Certain Rows from Workbook1 to Workbook2

 
 
=?Utf-8?B?Unlhbkg=?=
Guest
Posts: n/a
 
      26th Oct 2007
I am a VBA beginner and very eager to learn this stuff. What a great forum!
I have a Worksheet named "Global Production Schedule" in Workbook1 that has
several rows with Sales Order numbers Column A and there ship dates in Column
K. When the order is shipped the user highlights the ship date cell yellow.
At the end of the day I want the user to be able to click a button, then the
highlighted cell rows are cut and then pasted into Sheets("sheet1") Workbook2
named "Archive". The code I have is not working and I'm not sure why. Feel
free to change anything, because this code could be seriously incorrect.
NOTE: The button to call this macro is in a custom toolbar I made and the
macro is located in my personal workbook because the global schedule file
name changes everyday. Here is what I have so far:

Sub SendToArchive()

Dim LastRow As Long, InsertRow As Long, FinalRow As Long
Dim wsArchive As Worksheet, wsGlobal As Worksheet
Dim wbArchive As Workbook, wbGlobal As Workbook
Dim fName As Variant

'Current worksheet with highlighted cells
wsGlobal = ThisWorkbook.Sheets("Global Production Schedule")

'Message to prompt user to select the Archive file
Msg1 = MsgBox("Choose the Archive file you want the selected Sales Orders to
go too.")

'User selected Archive File name
fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls")

If fName1 = False Then
Exit Sub
Else
Set wbArchive = Workbooks.Open(fName)
End If

Msg2 = MsgBox("Are you sure you want to move highlighted Sales Orders from "
& NAME OF GLOBAL WORKBOOK & " to " & NAME OF ARCHIVE WORKBOOK & " ?",
vbOKCancel)
If Msg1 <> vbOK Then Exit Sub

Set wsArchive = wbArchive.Sheets("Archive")
LastRow = wsArchive.Cells(Rows.Count, "A").End(xlUp).Row
InsertRow = LastRow + 1
FinalRow = wsGlobal.Cells(Rows.Count, "A").End(xlUp).Row

For i = 3 To FinalRow
If Cells(i, 11).Interior.ColorIndex = 6 Then 'Yellow Cells
Cells(i, 11).EntireRow.Cut Destination:=wsArchive.Rows(InsertRow)
End If
Next i

Windows(fName).Close SaveChanges:=Save

End Sub
 
Reply With Quote
 
 
 
 
=?Utf-8?B?SkxHV2hpeg==?=
Guest
Posts: n/a
 
      26th Oct 2007
Just took a quick glance at the code. Comments below.

1.
fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls")

Looks like a typo.

2.
Msg2 = MsgBox("Are you sure you want to move highlighted Sales Orders from "
& NAME OF GLOBAL WORKBOOK & " to " & NAME OF ARCHIVE WORKBOOK & " ?",
vbOKCancel)
If Msg1 <> vbOK Then Exit Sub

Should this not be If Msg2 <> vbOK Then...?

3.
Windows(fName).Close SaveChanges:=Save

I would use:

Workbooks(fName).Close SaveChanges:=True

"RyanH" wrote:

> I am a VBA beginner and very eager to learn this stuff. What a great forum!
> I have a Worksheet named "Global Production Schedule" in Workbook1 that has
> several rows with Sales Order numbers Column A and there ship dates in Column
> K. When the order is shipped the user highlights the ship date cell yellow.
> At the end of the day I want the user to be able to click a button, then the
> highlighted cell rows are cut and then pasted into Sheets("sheet1") Workbook2
> named "Archive". The code I have is not working and I'm not sure why. Feel
> free to change anything, because this code could be seriously incorrect.
> NOTE: The button to call this macro is in a custom toolbar I made and the
> macro is located in my personal workbook because the global schedule file
> name changes everyday. Here is what I have so far:
>
> Sub SendToArchive()
>
> Dim LastRow As Long, InsertRow As Long, FinalRow As Long
> Dim wsArchive As Worksheet, wsGlobal As Worksheet
> Dim wbArchive As Workbook, wbGlobal As Workbook
> Dim fName As Variant
>
> 'Current worksheet with highlighted cells
> wsGlobal = ThisWorkbook.Sheets("Global Production Schedule")
>
> 'Message to prompt user to select the Archive file
> Msg1 = MsgBox("Choose the Archive file you want the selected Sales Orders to
> go too.")
>
> 'User selected Archive File name
> fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
> *.xls")
>
> If fName1 = False Then
> Exit Sub
> Else
> Set wbArchive = Workbooks.Open(fName)
> End If
>
> Msg2 = MsgBox("Are you sure you want to move highlighted Sales Orders from "
> & NAME OF GLOBAL WORKBOOK & " to " & NAME OF ARCHIVE WORKBOOK & " ?",
> vbOKCancel)
> If Msg1 <> vbOK Then Exit Sub
>
> Set wsArchive = wbArchive.Sheets("Archive")
> LastRow = wsArchive.Cells(Rows.Count, "A").End(xlUp).Row
> InsertRow = LastRow + 1
> FinalRow = wsGlobal.Cells(Rows.Count, "A").End(xlUp).Row
>
> For i = 3 To FinalRow
> If Cells(i, 11).Interior.ColorIndex = 6 Then 'Yellow Cells
> Cells(i, 11).EntireRow.Cut Destination:=wsArchive.Rows(InsertRow)
> End If
> Next i
>
> Windows(fName).Close SaveChanges:=Save
>
> End Sub

 
Reply With Quote
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Workbook1 opens Workbook2 and runs Workbook2's macro chuck buchanan Microsoft Excel Programming 2 7th Apr 2008 04:33 PM
Copying Selected Rows From Workbook1 to WorkBook2 seanswilson@gmail.com Microsoft Excel Misc 0 10th Oct 2006 11:27 PM
Copying Selected Rows From Workbook1 to WorkBook2 seanswilson@gmail.com Microsoft Excel Misc 0 10th Oct 2006 11:24 PM
Cut from workbook1, paste to workbook2, get automatic link in workbook1 nospam Microsoft Excel Discussion 1 18th May 2005 01:15 PM
Can we copy a sheet from workbook1 to workbook2 with out open workbook1? Lee Microsoft Excel Programming 4 23rd Jul 2004 09:28 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 02:14 AM.