Pasting into multiple worksheets VBA

[karldugan]

Hello all,

I have a workbook that has four permanent tabs - Values, Template, Data and Pivot. After Pivot, a macro creates new, blank worksheets; their names are based on information within the data fields and constantly change.

I would like a macro that grabs the information in the template and paste special formats & formula (this bit I can do) into each of the tabs after Pivot.

I can get the macro to work if by defining the names of each tab, but as I say, some months a new tab may appear and others drop off and the macro will break.

Any help would be greatly appreciated.

 

[Fishboy]

Hello all,

I have a workbook that has four permanent tabs - Values, Template, Data and Pivot. After Pivot, a macro creates new, blank worksheets; their names are based on information within the data fields and constantly change.

I would like a macro that grabs the information in the template and paste special formats & formula (this bit I can do) into each of the tabs after Pivot.

I can get the macro to work if by defining the names of each tab, but as I say, some months a new tab may appear and others drop off and the macro will break.

Any help would be greatly appreciated.

Hi karldugan, welcome to the boards.

The following macro will check each sheet currently in the active workbook and so long as the sheet name is NOT one of your 4 permanent sheets it will run your code. Simply put your existing copy macro (without the sub name or end sub lines) in the middle where it says "YOUR COPY CODE GOES HERE"

Sub CopyTemplate()
' Defines variable
Dim ws As Worksheet


' Defines variable nSheets as the sheets you want to ignore
nSheets = Array("Values", "Template", "Data", "Pivot")


' For each sheet in the active workbook
For Each ws In ActiveWorkbook.Worksheets
    ' If the sheet name is not in the list nSheets then...
    If Not IsNumeric(Application.Match(ws.Name, nSheets, 0)) Then
        ' Your template copying code goes here
        YOUR COPY CODE GOES HERE
    End If
' Check next sheet
Next ws


End Sub

 

[karldugan]

Hi Fishboy,

Thanks for the quick response, I'm guessing I've done something wrong, your bit of code just keeps pasting onto the template tab, it doesn't seem to move through the others; the below is the code I have so far, thanks for the help. Really appreciate it.

' Defines variable
Dim ws As Worksheet

' Defines variable nSheets as the sheets you want to ignore
nSheets = Array("Values", "Template", "Data", "Pivot")

' For each sheet in the active workbook
For Each ws In ActiveWorkbook.Worksheets
' If the sheet name is not in the list nSheets then...
If Not IsNumeric(Application.Match(ws.Name, nSheets, 0)) Then
' Your template copying code goes here
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Template").Select
Cells.Select
Range("C1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If

 

[Fishboy]

How about this:

Sub CopyTemplate()
' Defines variable
Dim ws As Worksheet

' Defines variable nSheets as the sheets you want to ignore
nSheets = Array("Values", "Template", "Data", "Pivot")

' For each sheet in the active workbook
For Each ws In ActiveWorkbook.Worksheets
    ' If the sheet name is not in the list nSheets then...
    If Not IsNumeric(Application.Match(ws.Name, nSheets, 0)) Then
        ' Copy the used range from the template sheet
        Sheets("Template").UsedRange.Copy
        ' Paste special to cell A1 of the current sheet
        ws.Range("A1").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End If
' Check next sheet
Next ws

' Turn off CutCopyMode
Application.CutCopyMode = xlCopy

End Sub

 

[karldugan]

You sir - Are a miracle worker! So happy right now!!!

 

[Fishboy]

You sir - Are a miracle worker! So happy right now!!!

No worries, you're most welcome mate