I have 2 workbooks (see attached) that i am using a button in wb1 to copy a range of cells based on the active cell and paste all formatting and values to the next available row in wb2.
I first tested my code to do this action in the same workbook and worked great. That code is available in the attached file (Master Production Schedule) under Module 2. I was able to use the Copy Destination:= in the same workbook, but that fails when opening a new workbook so I changed it to use the PasteSpecial option. Can someone help me fix this.Master Production Schedule.3.8.13 Test2.xlsmMaster PS Results 2013.xlsx
The code i have below does the following
1. Opens the closed workbook
2. Checks to see if it is read only
3. Copies my range based on the active cell
4. Pastes an Image at the next available row (i want to fill the next available row)
5. Saves wb2 and closes it
6. Reactivates wb1
7. Deletes the Line that was transferred
8. Performs some additional code to keep the existing table with the same # of rows.
Formula:
Sub LineShipped_Click()
Dim xNewApp As New Excel.Application
Dim xNewWB As New Excel.Workbook, wb1 As Workbook
Dim strFile As String, strfile2 As String
Dim cl As Range
Dim r As Long, lr As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False
'Verify that the user does want to activate this macro
If MsgBox("Are you sure you want to proceed with this change?", vbYesNo + vbCritical) = vbNo Then Exit Sub
strFile = "C:\Users\Jimmie\Desktop\Production Schedule\Master PS Results 2013.xlsx"
Set xNewWB = xNewApp.Workbooks.Open(strFile)
xNewWB.Activate
If xNewWB.ReadOnly Then
MsgBox "The Master Production Schedule is Read Only, close the file and try again"
xNewWB.Close
Exit Sub
Else
'Do Nothing and Continue
End If
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Sheet1")
Set cl = ActiveCell
r = cl.Row
Set ws2 = xNewApp.Sheets("Sheet1")
ws2.Activate
lr = ws2.Range("C" & Rows.Count).End(xlUp).Row
xNewApp.Cells(lr, 3).Activate 'Activates the cell found above
ws1.Range("C" & r, Range("Z" & r)).Copy
ws2.Range("C" & lr + 1).PasteSpecial Paste:=xlPasteAll
xNewWB.Save
xNewWB.Close
ws1.Activate
ActiveCell.EntireRow.Delete 'Delete the row with with the active cell
Rows("59:59").Select 'Select the last row in the named range
Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove 'Insert a new row to keep the named range with 60 rows
Cells(59, 1).Value = Cells(58, 1).Value
Cells(58, 29).Resize(2).FillDown
Cells(3, 1).Activate 'Acitvate a new cell at the top of the sheet
Application.ScreenUpdating = True
Set xNewWB = Nothing
Set xNewApp = Nothing
End Sub
Bookmarks