my original plan was to copy from a merged & centered range of A1:AG5 into the same size in the second book to no available with various cut and paste options.
After doing more reading and following others I have almost got it after tryingdifferent copy and paste options. Copy from a specified Workbook range (A1:A5), these are text values. Paste into active workbook which could be of any name to the range of (A35:A39).
Error pop up
Run-time error 1004, PasteSpecial Method of Range class failed.
Cells A1, A2, A3, A4 and A5 each has a text sentence which copies and pastes to A35, A36, A37,A38 and A39.
I can run the script and the error box pops up, click END and run the macro button again and the end result meets my requiremnts with the 5 rows having text copied from another book from A to AG with text centered across horizontally,
Option Explicit
Private Sub UpdateForm1_Click()
'Dim wsActive As Worksheet
'Set wsActive = ThisWorkbook.ActiveSheet
Dim wbActive As Workbook
Set wbActive = ThisWorkbook
Dim Up_Location As String
Dim Up_Name As String
Up_Location = "T:\Repeats\"
Up_Name = "PNL_UPDATE.xlsx"
Application.ScreenUpdating = False
Workbooks.Open Up_Location & Up_Name
Worksheets("Sheet1").Activate
ActiveSheet.Range("Text_1").Select
ActiveSheet.Range("Text_1").Copy
wbActive.Sheets("CustQuote").Unprotect Password:="1234"
wbActive.Worksheets("CustQuote").Activate
wbActive.Worksheets("CustQuote").Range("A35:A39").Select
wbActive.Worksheets("CustQuote").Range("A35:A39").PasteSpecial xlPasteAll
Range("A35:AG39").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
End With
Range("E2").Select
wbActive.Sheets("CustQuote").Protect Password:="1234"
Application.CutCopyMode = False
Windows("PNL_UPDATE.xlsx").Activate
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
CodePudding user response:
You might benefit from reading How to avoid using Select in Excel VBA.
Always copy right before you paste. Otherwise the code in between can interfere. Use Variables instead of selecting and activating sheets or ranges. Use With
blocks and/or variables to avoid repeating code and worksheet names.
Option Explicit
Private Sub UpdateForm1_Click()
Const ThisWbPassword As String = "1234" ' define password only once as constant.
Dim Up_Location As String
Up_Location = "T:\Repeats\"
Dim Up_Name As String
Up_Name = "PNL_UPDATE.xlsx"
Dim WbUp As Workbook ' set opened workbook to a variable for easy later use
Set WbUp = Workbooks.Open(Up_Location & Up_Name)
With ThisWorkbook.Worksheets("CustQuote")
.Unprotect Password:=ThisWbPassword
WbUp.Worksheets("Sheet1").Range("Text_1").Copy ' always copy right before pasting to avoid interference of code between.
With .Range("A35:A39")
.PasteSpecial xlPasteAll
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
End With
.Protect Password:=ThisWbPassword
End With
Application.CutCopyMode = False
WbUp.Close SaveChanges:=False
End Sub
The issue why your code worked the second time you run it is, that it stoped somewhere after .Unprotect
and you sheet was left unprotected. So the second run was on an unprotecdet sheet then.
Usually you want to cover that using error handling. So your sheet does never end in an unprotected state.
This is a basic error handling to ensure the sheet is protected again in the case of an error
Private Sub UpdateForm1_Click()
Const ThisWbPassword As String = "1234" ' define password only once as constant.
Dim Up_Location As String
Up_Location = "T:\Repeats\"
Dim Up_Name As String
Up_Name = "PNL_UPDATE.xlsx"
Dim WbUp As Workbook ' set opened workbook to a variable for easy later use
Set WbUp = Workbooks.Open(Up_Location & Up_Name)
With ThisWorkbook.Worksheets("CustQuote")
.Unprotect Password:=ThisWbPassword
On Error GoTo ReProtect ' in case of any error make sure the sheet is protected again
WbUp.Worksheets("Sheet1").Range("Text_1").Copy ' always copy right before pasting to avoid interference of code between.
With .Range("A35:A39")
.PasteSpecial xlPasteAll
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
End With
ReProtect:
.Protect Password:=ThisWbPassword
Err.Raise Err.Number 'throw the error message after protecting the sheet
End With
Application.CutCopyMode = False
WbUp.Close SaveChanges:=False
End Sub