CODEWITHSUNDEEP
excelformattingcopy-pastevba
Kyle Hinkebein
Kyle Hinkebein

Reputation: 83

Trying to copy Formatting in all cells from one Excell sheet into another specifically keeping fill and text color using VBA

I have a working VBA script that copies exactly what I need except formatting. I at least need it to copy Fill and Text color.

Here is my current code.

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Cells.Select
Range("A1").Activate
Selection.ClearContents
Selection.UnMerge
Selection.ClearContents
Range("A1").Select
Workbooks.Open Filename:= _
    "Photo\Studio\\DAILY_REPORT_BACKUPS\DIGI_Review_Terry.xlsm"
Range("A1:XFD70").Select
Range("A1:XFD70").Activate
Selection.Copy
ActiveWindow.Close
Range("A1").Select
Sheets("Terry").Paste
ActiveWorkbook.Save

End Sub>

Upvotes: 1

Views: 184

Answers (1)

chancea
chancea

Reputation: 5958

The direct problem lies within the order of execution. Currently you are:

  1. Opening the workbook with the macro
  2. Opening the workbook with the data
  3. Copying the data
  4. Closing the workbook with the data
  5. Pasting the data into the workbook with the macro
  6. Saving the workbook with the macro (and now also with data)

The issue with this is that if you perform step 4 before step 5 the formatting is lost and only the text remains on the clipboard. So that means we have to switch steps 4 and 5 in the execution process.

In addition we should get rid of those select statements and work with the ranges directly. This is best practice and easier to understand in the code.

Here is the code with the steps marked in the order we want them to execute:

Private Sub Workbook_Open() 'step 1
Dim wb As Workbook
Dim wb2 As Workbook
Set wb = ActiveWorkbook

Application.DisplayAlerts = False
Cells.ClearContents
Cells.UnMerge
Cells.ClearContents

'step 2
Workbooks.Open Filename:= _
    "Photo\Studio\\DAILY_REPORT_BACKUPS\DIGI_Review_Terry.xlsm"
Set wb2 = ActiveWorkbook

'step 3
wb2.ActiveSheet.Range("A1:XFD70").Copy

'step 5 (switch with 4)
wb.Sheets("Terry").Range("A1").PasteSpecial Paste:=xlPasteAll

'step 4 (switch with 5)
wb2.Close

'step 6
wb.Save
End Sub

Here is the same code without the crazy step comments:

Private Sub Workbook_Open()
Dim wb As Workbook
Dim wb2 As Workbook
Set wb = ActiveWorkbook

Application.DisplayAlerts = False
Cells.ClearContents
Cells.UnMerge
Cells.ClearContents

Workbooks.Open Filename:= _
    "Photo\Studio\\DAILY_REPORT_BACKUPS\DIGI_Review_Terry.xlsm"
Set wb2 = ActiveWorkbook

wb2.ActiveSheet.Range("A1:XFD70").Copy
wb.Sheets("Terry").Range("A1").PasteSpecial Paste:=xlPasteAll
wb2.Close
wb.Save

End Sub

Upvotes: 1

Related Questions