Copy & Paste Cell formats

Danny54

Active Member
Joined
Jul 3, 2019
Messages
295
Office Version
  1. 365
Platform
  1. Windows
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




Code:
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
 
Last edited by a moderator:

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
try replacing ...
Code:
rngResult.Copy Destination:=rngTarget

with this ...
Code:
rngResult.Copy
With rngTarget
    .PasteSpecial (xlPasteFormats)
    .PasteSpecial (xlPasteValues)
    .PasteSpecial (xlPasteColumnWidths)
End With



other options available too - depending on what you want to paste
Code:
    .PasteSpecial (xlPasteFormulas)
    .PasteSpecial (xlPasteFormulasAndNumberFormats)
    .PasteSpecial (xlPasteAll)
 
Last edited:
Upvote 0
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
 
Upvote 0
Is there no other info in the message?
At a guess it would be PasteSpecial method of Range class failed
 
Upvote 0
no other message except this one. Not certain why on xlPasteValues line. Is there a way to get more information on the failure?
 
Upvote 0
so what happens when you simply do this

Code:
rngResult.Copy
rngTarget.PasteSpecial (xlPasteAll)
 
Upvote 0
the macro completes successfully with the data copied but not the formats.
 
Upvote 0
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 :eek: how are your cells formatted? normally or with conditional formatting? and what formatting do you have applied?
 
Upvote 0
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.

:)
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top