Changing formats while copying from an open workbook to another

[zubinnajmi]

Hi Friends,
Am glad I have this forum to pull me out of my difficulties.
Here I am having a workbook open from which certain column ranges have to pulled and copied in a new workbook, The below code does exactly as i want.
The problem comes when I have to upload the new workbook to a website as the formats don't match.

1) The range M1:M300 contains SALE figures. If the sale figure is ZERO then the cell has to be left BLANK in the destination range F1:F300 and otherwise the other cells which have a sale figure to be copied as it is.


The rest of the ranges contain DATA which have to be copied in the same format (General) as they are in their respective ranges in the workbook.

Please Guide.

'Command Button For "Upload Report"
Private Sub CommandButton11_Click()
Dim samePath As String
Dim wb As Workbook
Dim Range1, Range2, Range3, Range4, Range5, Range6 As Range
Dim DestRange1, DestRange2, DestRange3, DestRange4, DestRange5, DestRange6 As Range
Dim my_Name As String
Dim strDate

strDate = ActiveSheet.Name
my_Name = InputBox("Enter Date MM-DD-YYYY", "Fravashi Beer and Wine Shop", "SCMSales")
samePath = ActiveWorkbook.Path & "\" & my_Name & strDate

If my_Name = " " Then

Exit Sub
ElseIf my_Name = "" Then
Exit Sub
End If

Set Range1 = ActiveSheet.Range("M1:M300") 'Quantity Loose bottles Sold
Set Range2 = ActiveSheet.Range("T1:T300") 'Sale date
Set Range3 = ActiveSheet.Range("Q1:Q300") 'Local item Code
Set Range4 = ActiveSheet.Range("R1:R300") 'Brand name
Set Range5 = ActiveSheet.Range("S1:S300") 'Size
Set Range6 = ActiveSheet.Range("DA1:DA300") 'Quantity case Sold

With Workbooks.Add
Set wb = ActiveWorkbook
With wb.ActiveSheet
Set DestRange1 = ActiveSheet.Range("F1:F300")
Set DestRange2 = ActiveSheet.Range("A1:A300")
Set DestRange3 = ActiveSheet.Range("B1:B300")
Set DestRange4 = ActiveSheet.Range("C1:C300")
Set DestRange5 = ActiveSheet.Range("D1:D300")
Set DestRange6 = ActiveSheet.Range("E1:E300")
End With
End With

Range1.Copy
DestRange1.PasteSpecial Paste:=xlPasteValues
DestRange1.PasteSpecial Paste:=xlPasteColumnWidths
DestRange3.PasteSpecial Paste:=xlPasteFormats
Range2.Copy
DestRange2.PasteSpecial Paste:=xlPasteValues
DestRange2.PasteSpecial Paste:=xlPasteColumnWidths
DestRange3.PasteSpecial Paste:=xlPasteFormats
Range3.Copy
DestRange3.PasteSpecial Paste:=xlPasteValues
DestRange3.PasteSpecial Paste:=xlPasteColumnWidths
DestRange3.PasteSpecial Paste:=xlPasteFormats
Range4.Copy
DestRange4.PasteSpecial Paste:=xlPasteValues
DestRange4.PasteSpecial Paste:=xlPasteColumnWidths
DestRange4.PasteSpecial Paste:=xlPasteFormats
Range5.Copy
DestRange5.PasteSpecial Paste:=xlPasteValues
DestRange5.PasteSpecial Paste:=xlPasteColumnWidths
DestRange5.PasteSpecial Paste:=xlPasteFormats
Range6.Copy
DestRange6.PasteSpecial Paste:=xlPasteValues
DestRange6.PasteSpecial Paste:=xlPasteColumnWidths
DestRange6.PasteSpecial Paste:=xlPasteFormats

Application.CutCopyMode = False
ActiveSheet.Range("G1").Select

wb.SaveAs Filename:=samePath
wb.Close
Application.ScreenUpdating = True
Range("B4").Select
End Sub

[spencer_time]

I'm not a talented enough coder to do anything complicated, but I have done something similar to this before.

You could try something like the following:

Sub cola_dte()

    With ActiveWorkbook.ActiveSheet
        ActiveSheet.Range("A1", "A50000").NumberFormat = "dd-MM-yyyy"
    End With
    
End Sub

[zubinnajmi]

Hi,
ok, I Solved the first part (So i have removed it from the original post)

NEED A SOLUTION FOR THE SECOND PART.

Source worksheet Range AU1:AU3000 MAY have certain cells with Zero value, these Zeros have to be left blank in the corresponding cells of the destination worksheet.


Please can any one help with the solution