Remove Formatting

P

paulstan

Board Regular
Joined
Mar 12, 2011
Messages
85
Firstly, many thanks to VoG for supplying the code in use.

The following code will copy columns (A,C,D,E,F) from Book1 to columns (C,A,F,E,D) in Book2. It all works with no errors. My problem now is that I need to have all formatting from selected cells in Book1 removed prior to it being copied to Book2. I know I need to use the PasteSpecial Method, but not sure where in the code to put it.

Code: 
Sub Copy()
' This will copy selected rows to new spreadsheet
' cannot copy non-contiguous cells.  Use filters instead
' Change i number from where copying is to commence from, so if copying from row 5 change to i = 5
On Error GoTo ErrorHandler
Dim LR As Long, LR2 As Long, i As Long
 
    If Selection.Rows.Count > 1 Then
        i = Selection.Row
        LR = Selection.Row + Selection.Rows.Count - 1
    Else
        i = 5
        LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    End If
 
'Destination row number start point (Row 8) - first data entry row
LR2 = WorksheetFunction.Max(8, Workbooks("Book2.xls").Sheets("Checking").Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1)
Range("A" & i & ":A" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("C" & LR2)
Range("C" & i & ":C" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("A" & LR2)
Range("D" & i & ":D" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("F" & LR2)
Range("E" & i & ":E" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("E" & LR2)
Range("F" & i & ":F" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("D" & LR2)
Application.CutCopyMode = False
ErrorHandler:
    If Err.Number = 5 Or Err.Number = 9 Then
        MsgBox "The file could not be found. Please open relevant file named 'Book2.xls' and try again"
        MsgBox "Error " & Err & " - " & Err.Description
    End If
End Sub

Regards

Paul S
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
Range("A" & i & ":A" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("C" & LR2).PasteSpecial Paste:=xlPasteValues Range("C" & i & ":C" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("A" & LR2).PasteSpecial Paste:=xlPasteValues Range("D" & i & ":D" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("F" & LR2).PasteSpecial Paste:=xlPasteValues Range("E" & i & ":E" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("E" & LR2).PasteSpecial Paste:=xlPasteValues Range("F" & i & ":F" & LR).SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Book2.xls").Sheets("Checking").Range("D" & LR2).PasteSpecial Paste:=xlPasteValues </pre>
 
Upvote 0
You could change that section to
Code: 
    With Workbooks("Book2.xls").Worksheets("Checking")
        Range("A" & i & ":A" & LR).SpecialCells(xlCellTypeVisible).Copy
        .Cells(LR2, "C").PasteSpecial Paste:=xlPasteValues
        Range("C" & i & ":C" & LR).SpecialCells(xlCellTypeVisible).Copy
        .Cells(LR2, "A").PasteSpecial Paste:=xlPasteValues
        Range("D" & i & ":D" & LR).SpecialCells(xlCellTypeVisible).Copy
        .Cells(LR2, "F").PasteSpecial Paste:=xlPasteValues
        Range("E" & i & ":E" & LR).SpecialCells(xlCellTypeVisible).Copy
        .Cells(LR2, "E").PasteSpecial Paste:=xlPasteValues
        Range("F" & i & ":F" & LR).SpecialCells(xlCellTypeVisible).Copy
        .Cells(LR2, "D").PasteSpecial Paste:=xlPasteValues
    End With
 
Upvote 0
Code: 
Range("A" & i & ":A" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("C" & LR2).PasteSpecial Paste:=xlPasteValues
Range("C" & i & ":C" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("A" & LR2).PasteSpecial Paste:=xlPasteValues
Range("D" & i & ":D" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("F" & LR2).PasteSpecial Paste:=xlPasteValues
Range("E" & i & ":E" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("E" & LR2).PasteSpecial Paste:=xlPasteValues
Range("F" & i & ":F" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("D" & LR2).PasteSpecial Paste:=xlPasteValues

My formatting got all screwy, sorry about that:

Code: 
Sub Copy()
' This will copy selected rows to new spreadsheet
' cannot copy non-contiguous cells.  Use filters instead
' Change i number from where copying is to commence from, so if copying from row 5 change to i = 5
On Error GoTo ErrorHandler
Dim LR As Long, LR2 As Long, i As Long
 
    If Selection.Rows.Count > 1 Then
        i = Selection.Row
        LR = Selection.Row + Selection.Rows.Count - 1
    Else
        i = 5
        LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    End If
 
'Destination row number start point (Row 8) - first data entry row
LR2 = WorksheetFunction.Max(8, Workbooks("Book2.xls").Sheets("Checking").Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1)
Range("A" & i & ":A" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("C" & LR2).PasteSpecial Paste:=xlPasteValues
Range("C" & i & ":C" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("A" & LR2).PasteSpecial Paste:=xlPasteValues
Range("D" & i & ":D" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("F" & LR2).PasteSpecial Paste:=xlPasteValues
Range("E" & i & ":E" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("E" & LR2).PasteSpecial Paste:=xlPasteValues
Range("F" & i & ":F" & LR).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Book2.xls").Sheets("Checking").Range("D" & LR2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ErrorHandler:
    If Err.Number = 5 Or Err.Number = 9 Then
        MsgBox "The file could not be found. Please open relevant file named 'Book2.xls' and try again"
        MsgBox "Error " & Err & " - " & Err.Description
    End If
End Sub
 
Upvote 0
Shg & Desu Nota

Many thanks for your help. I've gone with Desu Nota's version but will also try Shg's version.

I'm assuming (although not tried yet) that the With..EndWith version will stop the screen flicker during the copy?

Regards

Paul S
 
Upvote 0
No the screen flicker can be ended by adding the following as the first and last line of the code:

Application.ScreenUpdating = False (put under Sub Copy())


Application.ScreenUpdating = True (put this as last line above End Sub)
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA Copy/Paste from different workbooks
Replies
1
Views
385
NdNoviceHlp
NdNoviceHlp
J
  • Question Question
Append data to master file
Replies
6
Views
352
Alex Blakenburg
A
S
  • Solved
Copy values only without specific column formats VBA
Replies
9
Views
404
sofas
S
H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
149
howard
H
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
944
GarnesGambit
G

Forum statistics

Threads
1,224,514
Messages
6,179,220
Members
452,895
Latest member
BILLING GUY

Share this page

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