Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cut/Paste Certain Rows from Workbook1 to Workbook2
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cut/Paste Certain Rows from Workbook1 to Workbook2
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Extracting data from workbook1 to workbook2 | Excel Worksheet Functions | |||
Copying Selected Rows From Workbook1 to WorkBook2 | Excel Discussion (Misc queries) | |||
Copying Selected Rows From Workbook1 to WorkBook2 | Excel Discussion (Misc queries) | |||
Can we copy a sheet from workbook1 to workbook2 with out open workbook1? | Excel Programming | |||
How to save the workbook1 from workbook2 | Excel Programming |