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

 

[dlmoore99]

Ok, I had tried it there before and didn't work, working now, maybe after excel was restarted it refreshed something. DTpicker still not working whereas it was before, it's taking all rows and not the ones selected by the DT pickers.

 

[Fluff]

As the DTpicker code hasn't changed, something else must have, but with out being able to see your data It's difficult to know what.
That said, I don't understand what this part of your code is meant to be doing

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

 

[dlmoore99]

For i = 2 To lastrow [COLOR=#008000]'looking at all rows in worksheet("TGT") from 2 to lastrow, row 2 is the header row[/COLOR]
        sheetdate = ws.Cells(3, 2).Value 'th[COLOR=#008000]is is where the dates in the column start[/COLOR]
        If sheetdate >= startdate And sheetdate <= enddate Then [COLOR=#008000]'se[/COLOR][COLOR=#008000]ts the parameters to copy rows[/COLOR]
        ws.Range(ws.Cells(i, 1), ws.Cells(i, 15)).Copy Destination:=wb.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1) [COLOR=#008000]'copys rows to new workbook[/COLOR]
        End If
    Next i

 

[Fluff]

Sheetdate doesn't change as it's looking at a static cell ie B3.
So you will either copy all rows from a sheet or none.

 

[dlmoore99]

so how would I fix it, I tried code below and get error Type Mismatch

sheetdate = ws.Cells(i, 2).Value

how can I fix this code to copy all rows that are >= startdate and <= enddate?

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
        
    startdate = Me.DTPicker1.Value
    enddate = Me.DTPicker2.Value
    lastrow = ws.UsedRange.Rows.Count
    For i = 2 To lastrow
        [COLOR=#ff0000]sheetdate = ws.Cells(i, 2).Value [/COLOR][COLOR=#008000]'Type Mismatch[/COLOR]
        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
    
        ws.Cells.Copy
        With wb.Sheets(1).Cells
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End With
        
    wb.SaveAs ThisWorkbook.Path & "\Target Log " & Format(enddate, "dd_mm_yyyy") & ".xlsm", 52
End Sub

What I don't understand is that the code was working before I tried to add the save as code.

 

[Fluff]

What is the value of i when you get the error, and what is in that cell?
so if i was 2 what is in B2

 

[dlmoore99]

B2 on the "TGT worksheet is the Date header, the dates start in B3

 

[Fluff]

Then try

 For i = 3 To lastrow

 

[dlmoore99]

I lose the headers with that code, but the DTpicker dates work properly. The headers on worksheet("TGT") are on row 2 and would like them to copy over as well. So just to recap, on worksheet ("TGT") the headers are in row 2, the data I want to copy starts on row 3 to last row, I want to copy all rows that are = to and between the start and end dates that are selected via the dtpickers.

 

[Fluff]

Try

   Ws.Range("A2:O2").Copy wb.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
   For i = 3 To lastrow
      sheetdate = Ws.Cells(i, 2).Value 'Type Mismatch
      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