• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to loop sheets and copy values & formats to another workbook

B

brianmock

Member
I need code to loop through the current workbook visible sheets that are not named "Contents"
Copy the values and conditional formats

paste to another workbook (with known name and sheets already named the same as the source)
paste as values and formats

SourceWB is .xlsb
DestWB is .xls
 
How's this?
Code: 
Sub CopySheets()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim ws As Worksheet

Set sourceWB = ThisWorkbook
'Asssume destination workbook is already open
Set destWB = Workbooks("DestWB.xls")

Application.ScreenUpdating = False
For Each ws In sourceWB.Worksheets
    'Check sheet's name and make sure it's visible
    If ws.Name <> "Contents" And ws.Visible = True Then
        ws.UsedRange.Copy
        'Paste values and formats to destination workbook
        'Assumes destination workbook already has sheets named correctly
        With destWB.Worksheets(ws.Name).Range("A1")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
        End With
    End If
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Code: 
Sub CopySheets()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim ws As Worksheet
 
Set sourceWB = ThisWorkbook
Set destWB = Workbooks("testTarget.xls")
 
Dim LastColumn As Long
Dim LastRow As Long
 
For Each ws In sourceWB.Worksheets
    If ws.Name <> "Contents" And ws.Visible = True Then
        ws.Select
        LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
        LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
        Set TheSetRange = ActiveCell.Range(Cells(1, 1), Cells(LastRow, LastColumn))
        TheSetRange.Select
        Selection.Copy
       
        destWB.Worksheets(ws.Name).Range("A1").Activate
        With destWB.Worksheets(ws.Name).TheSetRange.Select
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
        End With
    End If
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True

Getting an error Run-time error '1004':
This operation requires the merged cells to be identically sized

(1) I created a destwb as a copy of sourcewb (with selected sheets)
(2) I have tried to copy the usedrange but do not understand how to use destWB.worksheets(ws.name).
 
Ugh, merged cells, the bane of VBA. :(
Very well, we can try and work around it. We'll have the code clear out any formatting in the destination (since we're copying the formatting, shouldn't matter). New code:
Code: 
Sub CopySheets()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim ws As Worksheet

Set sourceWB = ThisWorkbook
'Asssume destination workbook is already open
Set destWB = Workbooks("DestWB.xls")

Application.ScreenUpdating = False
For Each ws In sourceWB.Worksheets
    'Check sheet's name and make sure it's visible
   If ws.Name <> "Contents" And ws.Visible = True Then
        'Clear any formatting currently in destination
        destWB.Worksheets(ws.Name).Cells.Clear
   
        ws.UsedRange.Copy
        'Paste values and formats to destination workbook
       'Assumes destination workbook already has sheets named correctly
       With destWB.Worksheets(ws.Name).Range("A1")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
        End With
    End If
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

For a teaching moment, I noticed that in your edits, you like Select-ing everything. 99% of the time, you don't need to (and shouldn't) select items, as it slows things down, and you can interact with the object directly.

In this line:
destWB.Worksheets(ws.Name)

We're saying to go to the destination workbook, and find a worksheet with same name as our source (ws) name. When you wrote this:
destWB.Worksheets(ws.Name).TheSetRange.Select

It should cause a compile error. TheSetRange was a variable you created that referred to a range on the source worksheet. So, there's no way the code can go to the destination worksheet and select the range on source worksheet.

A analogy to explain:
Each object in VB can be thought of as belonging to a "larger" parent. This is similar to how we can say "Go to the USA (workbook), to the state of Indiana (worksheet), to the city of Indianapolis (range)." If you and I are both in Indiana, I could say "Go to Indianapolis" and you know exactly what I mean, because you're already in Indiana. However, if you were in Great Britain, and I said "Go to Indianapolis", you'd look around and get confused because there's no Indianapolis in Great Britain. Hopefully this explains a little bit about when in VBA we need to call out workbook and/or worksheet names, and when we don't.
 
This works...
is there a faster (or more elegant) way to set the destwb.ws range to "A1" for the end user"

Code: 
For Each ws In destWB.Worksheets
    If ws.Visible = True Then
      ws.Activate
      Range("A1").Select
    End If
Next ws
 
Nope, that looks pretty good as is. Only thing I might add is to make sure that destWB is the active workbook via
Code: 
destWB.Activate

and that the snippet of code is within a set of ScreenUpdating being turned off/on (which I'm guessing it is)
 
Perhaps it's time to take a pause and rethink how you are approaching the problem. Rather than copying from one workbook to another, making it look identical, and have graphs point to new data, what if instead we:
  1. With the original workbook, do a Save As to new name
  2. Delete Contents worksheet
  3. Loop through all sheets and change all formulas to constants
Would that achieve the same overall goal?
 
Can I:
(1) Hide all worksheets that don't have charts
(2) copy the chart from each visible sheet in sourcewb
(3) paste to the correspondingly named sheet in destwb as values or break the link
 
If you just want the image of the chart, I'd paste the chart as a picture. Here's a quick script that copies all the charts as pictures to the destination workbook's first sheet. Now we don't have to worry about formulas or links.
Code: 
Sub CopyCharts()
Dim ch As ChartObject
Dim ws As Worksheet
Dim destWB As Workbook
Dim recCount As Long

'How far apart should charts be?
Const myOffset As Long = 20
'Where are we going to?
Set destWB = Workbooks("DestWB.xls")

recCount = 0
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    For Each ch In ws.ChartObjects
        ch.CopyPicture xlScreen, xlBitmap
        With destWB.Worksheets(1)
            .Paste .Cells(recCount * myOffset + 1, "A")
        End With
        recCount = recCount + 1
    Next ch
Next ws
Application.ScreenUpdating = True
End Sub
 
You must log in or register to reply here.
Back
Top