Copy & Paste Cell formats

[Danny54]

i keep wrestling with the copy and past between workbooks/worksheets. The code below prompts for a range date then selects data from a worksheet based on the date entered and successfully creates a new workbook and copies the correct data. However the new sheet isnt formatted the same. This is the copy statements from below. Do i need a xlPasteFormat of some kind or will this type of copy not work to copy the data?



Set rngResult = rngFull.SpecialCells(xlCellTypeVisible)
rngResult.Copy Destination:=rngTarget



Thanks

Option Explicit


'This subroutine prompts the user to select dates
Public Sub PromptUserForInputDates()
    
    Dim strStart As String, strEnd As String, strPromptMessage As String
    
    'Prompt the user to input the start date
    strStart = InputBox("Please enter the cutoff date")
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date..."
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    
    'Call the next subroutine, which will do produce the output workbook
    Call CreateSubsetWorkbook(strStart)
    
End Sub


'This subroutine creates the new workbook based on input from the prompts
Public Sub CreateSubsetWorkbook(StartDate As String)
    
    Dim wbkOutput As Workbook
    Dim wksOutput As Worksheet, wks As Worksheet
    Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
    Dim rngFull As Range, rngResult As Range, rngTarget As Range
    
    'Set references up-front
    lngDateCol = 7 '<~ we know dates are in column G
    Set wbkOutput = Workbooks.Add
    
    'Loop through each worksheet
    For Each wks In ThisWorkbook.Worksheets
        With wks
        
            'Create a new worksheet in the output workbook
            Set wksOutput = wbkOutput.Sheets.Add
            wksOutput.Name = wks.Name
            
            'Create a destination range on the new worksheet that we
            'will copy our filtered data to
            Set rngTarget = wksOutput.Cells(1, 1)
        
            'Identify the data range on this sheet for the autofilter step
            'by finding the last row and the last column
            lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
            lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column
            Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
            
            'Apply a filter to the full range to get only rows that
            'are in between the input dates
            With rngFull
                .AutoFilter Field:=lngDateCol, _
                            Criteria1:=">=" & StartDate
                            
                'Copy only the visible cells and paste to the
                'new worksheet in our output workbook
                
                Set rngResult = rngFull.SpecialCells(xlCellTypeVisible)
                rngResult.Copy Destination:=rngTarget
           
            End With
            
            'Clear the autofilter safely
            .AutoFilterMode = False
            If .FilterMode = True Then
                .ShowAllData
            End If
        End With
    Next wks
    
    'Let the user know our macro has finished!
    MsgBox "Data transferred!"


End Sub

 

[Yongle]

try replacing ...

rngResult.Copy Destination:=rngTarget

with this ...

rngResult.Copy
With rngTarget
    .PasteSpecial (xlPasteFormats)
    .PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteColumnWidths)
End With

other options available too - depending on what you want to paste

    .PasteSpecial (xlPasteFormulas)
    .PasteSpecial (xlPasteFormulasAndNumberFormats)
    .PasteSpecial (xlPasteAll)

 

[Danny54]

Thanks for the help.

I've updated the code as suggested -

rngResult.Copy
With rngTarget
.PasteSpecial (xlPasteFormats)
.PasteSpecial (xlPasteValues)
.PasteSpecial (xlPasteColumnWidths)
End With

Stepping thru the code one line at a time, I get thru the xlPasteFormats but after the xlPasteValues, I receive a Run-time error 1004.

Suggestion?


Again- Thanks

 

[Yongle]

Is there no other info in the message?
At a guess it would be PasteSpecial method of Range class failed

 

[Danny54]

no other message except this one. Not certain why on xlPasteValues line. Is there a way to get more information on the failure?

 

[Yongle]

so what happens when you simply do this

rngResult.Copy
rngTarget.PasteSpecial (xlPasteAll)

 

[Danny54]

the macro completes successfully with the data copied but not the formats.

 

[MARK858]

the macro completes successfully with the data copied but not the formats.

If that is the result that you get with that code then your Excel is acting very oddly how are your cells formatted? normally or with conditional formatting? and what formatting do you have applied?

 

[Danny54]

You pointed me to the right thing.(look at the formats on the input). I took a look at the formats of the input file and they were all marked general. I change my dates to a date format and it copied correctly.

Also, i found that any column having a empty date field wasn't copied. Must be something about copying empty fields using a filter. It copied data before the blank column and after but not the row where the date field was blank. I'll followup and see if I can work around that.

I appreciate all the help.

 

[MARK858]

i found that any column having a empty date field wasn't copied

Your Autofilter only looks at one column... Column G.
If you mean rows then it looks at cells that are greater than the start date so yes a blank cell will be ignored.