VBA - copy column widths and formats from one WS to new WB

[dlmoore99]

I'm trying to copy rows from one worksheet to a new worksheet while keeping the formatting (column widths etc..) of the active worksheet. I'm getting a "Run-time error '438': Object doesn't support this property type or method". How can I fix this code to copy the active sheet formats to the new sheet. Thank you.

Private Sub cmdCSV_Click()
    Dim lastrow As Long, i As Long, erow As Long
    Dim sheetdate As Date, startdate As Date, enddate As Date
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("TGT")
    Set wb = Workbooks.Add
        
        ws.Cells.Copy
       [COLOR=#FF0000] With wb.Cells 'this is where the error occurs[/COLOR]
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End With
   
    startdate = Me.DTPicker1.Value
    enddate = Me.DTPicker2.Value
    lastrow = ws.UsedRange.Rows.Count
    For i = 2 To lastrow
        sheetdate = ws.Cells(3, 2).Value
        If sheetdate >= startdate And sheetdate <= enddate Then
        ws.Range(ws.Cells(i, 1), ws.Cells(i, 15)).Copy Destination:=wb.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next i
End Sub

 

[Fluff]

Try

with wb.sheets(1).cells

 

[dlmoore99]

Sweet, I knew it was something easy and I should be learning this stuff by now, thank you Fluff. Works perfectly. I know you are suppose to open a new thread, but if I may, how can I add a name to the new workbook in the above code. I've tried adding some code but it's not working yet.

Private Sub cmdCSV_Click()
    Dim lastrow As Long, i As Long, erow As Long
    Dim sheetdate As Date, startdate As Date, enddate As Date
    Dim wb As Workbook
    Dim ws As Worksheet
    [COLOR=#FF0000]Dim wbName As String
    
    wbName = "Target Log" & Me.DTPicker2.Value[/COLOR]
    
    Set ws = ThisWorkbook.Worksheets("TGT")
    Set wb = Workbooks.Add
        
        ws.Cells.Copy
        With wb.Sheets(1).Cells
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End With
   
    startdate = Me.DTPicker1.Value
    enddate = Me.DTPicker2.Value
    lastrow = ws.UsedRange.Rows.Count
    For i = 2 To lastrow
        sheetdate = ws.Cells(3, 2).Value
        If sheetdate >= startdate And sheetdate <= enddate Then
        ws.Range(ws.Cells(i, 1), ws.Cells(i, 15)).Copy Destination:=wb.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next i
End Sub

 

[Fluff]

What is the value of wbName?

 

[dlmoore99]

I was going to call the new workbook "Target Log" and add the date from the enddate "Me.DTPicker2.Value"

 

[Fluff]

You can't name a workbook as such, you need to SaveAs

wb.SaveAs ThisWorkbook.Path & "\Target Log " & format(Me.dtpicker2.Value, "dd_mm_yyyy") & ".xlsm", 52

 

[dlmoore99]

Ok, and where do I add that piece of code?

 

[Fluff]

At the end of your code.

 

[dlmoore99]

I've tried multiple locations and not working, getting Run-time error 1004. Also the dtpicker is now selecting and copying rows outside the parameters. The code just froze excel and had to start excel.

 

[Fluff]

Ok, try

        End If
    Next i
    wb.SaveAs ThisWorkbook.Path & "\Target Log " & format(enddate, "dd_mm_yyyy") & ".xlsm", 52
End Sub