ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,699
- Office Version
- 2007
- Platform
- Windows
I use the code below
In the array we are looking at M,E of which are dates.
In column M the date example is 05/07/2017 but when i transfer to another worksheet i see 42921 & its formated as GENERAL.
Please advise how i get to see it as DATE & 05/07/2017 dd/mm/yyyy as opposed 42921 GENERAL
Or do i need to make this happen on the worksheet its going to ?
Thanks
In the array we are looking at M,E of which are dates.
In column M the date example is 05/07/2017 but when i transfer to another worksheet i see 42921 & its formated as GENERAL.
Please advise how i get to see it as DATE & 05/07/2017 dd/mm/yyyy as opposed 42921 GENERAL
Or do i need to make this happen on the worksheet its going to ?
Thanks
Rich (BB code):
Private Sub Kdx2_Click()
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
Dim r As Long
Dim x
Dim answer As Integer
answer = MsgBox("DO YOU WISH TO TRANSFER THESE KDX2 FILES ?", vbInformation + vbYesNo, "KDX2 TRANSFER MESSAGE")
If answer = vbNo Then
Exit Sub
Else
If ActiveCell.Column > 1 Then Exit Sub
' Grab row number of active row
r = ActiveCell.Row
On Error Resume Next
Set DestWB = Application.Workbooks("CLONING-KDX2.xlsm")
If DestWB Is Nothing Then
Workbooks.Open fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\CLONING-KDX2.xlsm"
Set DestWB = Application.Workbooks("CLONING-KDX2.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("KDX2LIST")
ColArr = Array("A:A", "D:B", "G:C", "N:D", "M:E", "L:F", "I:G")
Dim DestNextRow As Long
With DestWS
DestNextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
Application.ScreenUpdating = False
For Each SCol In ColArr
DCol = Split(SCol, ":")(1)
SCol = Split(SCol, ":")(0)
With ws
Set rng = .Cells(r, SCol)
End With
With DestWS
Set rngDest = .Range(DCol & DestNextRow)
End With
rng.Copy
rngDest.PasteSpecial PASTE:=xlPasteValues
rngDest.Borders.Weight = xlThin
rngDest.Font.Size = 16
rngDest.Font.Bold = True
rngDest.HorizontalAlignment = xlCenter
rngDest.Cells.Interior.ColorIndex = 6
rngDest.Cells.RowHeight = 25
Next SCol
Application.ScreenUpdating = True
With Sheets("KDX2LIST")
If .AutoFilterMode Then .AutoFilterMode = False
x = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A3:G" & x).Sort Key1:=.Range("A3"), Order1:=xlAscending, Header:=xlYes, DataOption1:=xlSortTextAsNumbers
.Range("A1").Select
ActiveWorkbook.Close savechanges:=True
End With
End If
End Sub