ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,699
- Office Version
- 2007
- Platform
- Windows
I am using the code below.
Basically i transfer values from one workbook to another.
The code added is just to save & then close workbook but i keep getting asked to cintinue etc.
Please advise what i should change so i dont have to select YES each time.
Screenshot attached
Basically i transfer values from one workbook to another.
The code added is just to save & then close workbook but i keep getting asked to cintinue etc.
Please advise what i should change so i dont have to select YES each time.
Screenshot attached
Rich (BB code):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("C6", Cells(Rows.Count, "C").End(xlUp)), Target) Is Nothing Then
Cancel = True
Dim WB As Workbook, DestWB As Workbook
Dim WS As Worksheet, DestWS As Worksheet
Dim rng As Range, rngDest As Range
Dim ColArr As Variant, SCol As Variant, DCol As Variant
On Error Resume Next
Set DestWB = Application.Workbooks("KEY CODES.xlsm")
If DestWB Is Nothing Then
Workbooks.Open fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\KEY CODES.xlsm"
Set DestWB = Application.Workbooks("KEY CODES.xlsm")
End If
On Error GoTo 0
Set WB = ThisWorkbook
On Error Resume Next
Set WS = WB.Worksheets("DATABASE")
On Error GoTo 0
If WS Is Nothing Then
MsgBox "Worksheet 'DATABASE' is missing"
Exit Sub
End If
Set DestWS = DestWB.Worksheets("KEYCODES")
ColArr = Array("D:A", "C:B", "J:C", "K:D")
Application.ScreenUpdating = False
For Each SCol In ColArr
DCol = Split(SCol, ":")(1)
SCol = Split(SCol, ":")(0)
With WS
Set rng = .Cells(Target.Row, SCol)
End With
With DestWS
If IsEmpty(.Range(DCol & 1)) Then
Set rngDest = .Range(DCol & 1)
Else
Set rngDest = .Range(DCol & .Rows.Count).End(xlUp).Offset(1)
End If
End With
rng.Copy
rngDest.PasteSpecial Paste:=xlPasteAll
rngDest.Borders.Weight = xlThin
rngDest.Font.Size = 14
rngDest.Font.Bold = True
rngDest.HorizontalAlignment = xlCenter
rngDest.Cells.Interior.ColorIndex = 6
rngDest.Cells.RowHeight = 25
Next SCol
Application.ScreenUpdating = True
End If
ActiveWorkbook.Close _
SaveChanges:=True, _
fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\KEY CODES.xlsm"
End Sub