Paste Source Theme formatting

[Alexis]

Afternoon all

I have some code which copies the values from certain sheets from a workbook to a new workbook.

It works fine, but what I'm trying to get it to do is copy the source formatting then values. When I say formatting, I mean like using paste special PasteAllUsingSourceTheme, as the data are formatted as tables in the original workbook.

The previous code I had written went back and forth copying all cells in the original sheet, pasting all using source theme to the new sheet, then copying that sheet and paste values over it.
First run would be fine, second take a while then the third would kill the computer.

This method is more or less instant but doesn't format nicely, obviously as it's values only.

Basically, I want it to look pretty like the original sheet!!!

See code below.

Thanks in advance
Alexis

Sub NameTheCopyRanges()

Set Newbook = Workbooks.Add

ActiveSheet.Name = "Region"
Sheets("Sheet2").Name = "Days Data"
Sheets("Sheet3").Name = "Perm Data"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Leaderboard EDC"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Leaderboard Area EDC"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Leaderboard LT"
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Leaderboard Area LT"


Set CommCompRegion = ThisWorkbook.Worksheets("RM notification").[A2:S200]
Set NewRegion = Newbook.Worksheets("Region").[A2:S200]

Set CommCompDaysData = ThisWorkbook.Worksheets("Days Data").[A2:O80000]
Set NewDaysData = Newbook.Worksheets("Days Data").[A2:O80000]

Set CommCompPermData = ThisWorkbook.Worksheets("Perm Data").[A2:N1000]
Set NewPermData = Newbook.Worksheets("Perm Data").[A2:N1000]

Set CommCompLeaderboardEDC = ThisWorkbook.Worksheets("LeaderboardEDC").[A2:K80]
Set NewLeaderboardEDC = Newbook.Worksheets("Leaderboard EDC").[A2:K80]

Set CommCompLeaderboardAreaEDC = ThisWorkbook.Worksheets("LeaderboardAreaEDC").[A2:G400]
Set NewLeaderboardAreaEDC = Newbook.Worksheets("Leaderboard Area EDC").[A2:G400]

Set CommCompLeaderboardLT = ThisWorkbook.Worksheets("LeaderboardLT").[A2:I100]
Set NewLeaderboardLT = Newbook.Worksheets("Leaderboard LT").[A2:I100]

Set CommCompLeaderboardAreaLT = ThisWorkbook.Worksheets("LeaderboardAreaLT").[A2:K400]
Set NewLeaderboardAreaLT = Newbook.Worksheets("Leaderboard Area LT").[A2:K400]


NewRegion.Value = CommCompRegion.Value
NewDaysData.Value = CommCompDaysData.Value
NewPermData.Value = CommCompPermData.Value
NewLeaderboardEDC.Value = CommCompLeaderboardEDC.Value
NewLeaderboardAreaEDC.Value = CommCompLeaderboardAreaEDC.Value
NewLeaderboardLT.Value = CommCompLeaderboardLT.Value
NewLeaderboardAreaLT.Value = CommCompLeaderboardAreaLT.Value


End Sub

 

[Deepak]

Hi,

You might need something like this.

Range("B1:D8").Copy
    Range("I3").PasteSpecial xlPasteAll
    Range("I3").PasteSpecial xlPasteColumnWidths

 

[Alexis]

Hi Deepak

Thanks for your response.

I'll give it a try and let you know how I get on.

 

[Alexis]

Hi again Deepak,

Using your suggested method (and some other bits and pieces added on) I achieved my goal.

Thanks very much for your help.

Regards,
Alexis