Copy and Save with VBA keep source coloumn widht and row height. is possible?

[pasaico]

I'm trying to copy the contents of a sheet into a new .xlsx document.
I can not keep source coloumn widht and row height.

For i = 1 To wksht.Range("A" & wksht.Rows.Count).End(xlUp).Row
        Set wb = Application.Workbooks.Add
        dataRange.Copy wb.Sheets(1).Range("A1", wb.Sheets(1).Cells(dataRange.Rows.Count, dataRange.Columns.Count))
        wb.SaveAs filename:=path & wksht.Range("A" & i).Value & ".xlsx"
        wb.Close
    Next i

Left is SOURCE --------> RIGHT is COPY/PASTE from code VBA above

 

[My Aswer Is This]

You need to use copy like this example.

Columns(2).Copy
Columns(3).PasteSpecial xlPasteAll

 

[pasaico]

You need to use copy like this example.

Columns(2).Copy
Columns(3).PasteSpecial xlPasteAll

I use saveAS not paste
can you help me?

 

[Fluff]

If you're copying the entire sheet, another option would be

   For i = 1 To wksht.Range("A" & wksht.Rows.Count).End(xlUp).Row
        Sheets("Sheet1").Copy
        ActiveWorkbook.SaveAs fileName:=path & wksht.Range("A" & i).Value & ".xlsx"
        ActiveWorkbook.Close
    Next i

 

[pasaico]

If you're copying the entire sheet, another option would be

   For i = 1 To wksht.Range("A" & wksht.Rows.Count).End(xlUp).Row
        Sheets("Sheet1").Copy
        ActiveWorkbook.SaveAs fileName:=path & wksht.Range("A" & i).Value & ".xlsx"
        ActiveWorkbook.Close
    Next i

not work...and i copy with range value.
Thank you

 

[Fluff]

If you are only copying a portion of the sheet, we will need to see your complete code.

 

[pasaico]

If you are only copying a portion of the sheet, we will need to see your complete code.

Private Sub CommandButton1_Clickl()

    Dim wksht As Worksheet
    Set wksht = ActiveSheet

    Dim path As String
    path = "C:\test\"

    If Len(Dir(path, vbDirectory)) = 0 Then
        MkDir path
    End If

    Dim rngeStart
    Dim rngeEnd

    Set rngeStart = wksht.UsedRange.Find(What:="####", LookIn:=xlValues, LookAt:=xlWhole)
    Set rngeEnd = wksht.UsedRange.FindNext(After:=rngeStart)

    Dim dataRange As Range
    Set dataRange = wksht.Range(rngeStart, rngeEnd)

    Dim wb As Workbook
    Dim i As Long

    For i = 1 To wksht.Range("A" & wksht.Rows.Count).End(xlUp).Row
        Set wb = Application.Workbooks.Add
        dataRange.Copy wb.Sheets(1).Range("A1", wb.Sheets(1).Cells(dataRange.Rows.Count, dataRange.Columns.Count))
        wb.SaveAs filename:=path & wksht.Range("A" & i).Value & ".xlsx"
        wb.Close
    Next i

End Sub

 

[Fluff]

How about

Private Sub CommandButton1_Clickl()

    Dim wksht As Worksheet
    Set wksht = ActiveSheet

    Dim path As String
    path = "C:\test\"

    If Len(Dir(path, vbDirectory)) = 0 Then
        MkDir path
    End If

    Dim rngeStart
    Dim rngeEnd

    Set rngeStart = wksht.UsedRange.Find(What:="####", lookIn:=xlValues, LookAt:=xlWhole)
    Set rngeEnd = wksht.UsedRange.FindNext(After:=rngeStart)

    Dim dataRange As Range
    Set dataRange = wksht.Range(rngeStart, rngeEnd)

    Dim wb As Workbook
    Dim i As Long

    For i = 1 To wksht.Range("A" & wksht.Rows.Count).End(xlUp).Row
      wksht.Copy
      With ActiveSheet
         .Range(.Cells(1, 1), .Cells(1, rngeStart.Column - 1)).EntireColumn.Delete
         .Rows("1:" & rngeStart.Row - 1).Delete
      End With
        ActiveWorkbook.SaveAs fileName:=path & wksht.Range("A" & i).Value & ".xlsx"
        ActiveWorkbook.Close
    Next i

End Sub

 

[pasaico]

thank you Fluff
it's ok.
you are genius

 

[Fluff]

Glad to help & thanks for the feedback