Copying selected worksheets (value and formatting only) VBA

Benjeejump

New Member
Joined
Feb 8, 2019
Messages
6
Hi,

I have virtually no VBA knowledge, and am looking to copy the same selected sheets every week, and paste their values and formatting only into a new workbook. I think this can be done with a VBA macro?
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Hi, this is possible with a macro. Are there certain criteria for which sheets to copy from? Also, do you want to copy all the data from those certain sheets into the same new workbook or each sheet's data into separate new workbooks?
 
Upvote 0
Hi, this is possible with a macro. Are there certain criteria for which sheets to copy from? Also, do you want to copy all the data from those certain sheets into the same new workbook or each sheet's data into separate new workbooks?

The only criteria is the sheet name (which will always be the same). Yes from those selected sheets to the same new workbook.
 
Upvote 0
You can try something like this, not sure if it's the most efficient way but it should work. It assumes that you want the data pasted starting in cell A1.

Code:
Function IsInArray(stringToBeFound As String, arr As Variant) As Long
  Dim i As Long
  ' default return value if value not found in array
  IsInArray = -1

  For i = LBound(arr) To UBound(arr)
    If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then
      IsInArray = i
      Exit For
    End If
  Next i
End Function


Sub test()
Dim shnames As Variant
Dim sh As Worksheet
Dim oWB As Workbook
Dim nWB As Workbook
Dim x As Integer
Dim getname As String
shnames = Split("H21 Sales Upload,H21 Rental Upload,Anchor Upload,Girlings Upload,McStone Upload,RHS Upload,RM Upload", ",")
Set oWB = ThisWorkbook
Workbooks.Add
Set nWB = ActiveWorkbook
x = 1
For Each sh In oWB.Sheets
    If IsInArray(sh.Name, shnames) > -1 Then
        getname = sh.Name
        sh.Cells.Copy
            If x = 1 Then
                nWB.Sheets(x).Name = getname
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteValues
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteFormats
                x = x + 1
            Else
                nWB.Sheets.Add after:=nWB.Worksheets(Worksheets.Count)
                nWB.Sheets(x).Name = getname
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteValues
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteFormats
                x = x + 1
            End If
    End If
Next sh
Application.CutCopyMode = False
End Sub
 
Upvote 0
You can try something like this, not sure if it's the most efficient way but it should work. It assumes that you want the data pasted starting in cell A1.

Code:
Function IsInArray(stringToBeFound As String, arr As Variant) As Long
  Dim i As Long
  ' default return value if value not found in array
  IsInArray = -1

  For i = LBound(arr) To UBound(arr)
    If StrComp(stringToBeFound, arr(i), vbTextCompare) = 0 Then
      IsInArray = i
      Exit For
    End If
  Next i
End Function


Sub test()
Dim shnames As Variant
Dim sh As Worksheet
Dim oWB As Workbook
Dim nWB As Workbook
Dim x As Integer
Dim getname As String
shnames = Split("H21 Sales Upload,H21 Rental Upload,Anchor Upload,Girlings Upload,McStone Upload,RHS Upload,RM Upload", ",")
Set oWB = ThisWorkbook
Workbooks.Add
Set nWB = ActiveWorkbook
x = 1
For Each sh In oWB.Sheets
    If IsInArray(sh.Name, shnames) > -1 Then
        getname = sh.Name
        sh.Cells.Copy
            If x = 1 Then
                nWB.Sheets(x).Name = getname
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteValues
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteFormats
                x = x + 1
            Else
                nWB.Sheets.Add after:=nWB.Worksheets(Worksheets.Count)
                nWB.Sheets(x).Name = getname
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteValues
                nWB.Sheets(x).Range("A1").PasteSpecial xlPasteFormats
                x = x + 1
            End If
    End If
Next sh
Application.CutCopyMode = False
End Sub


That works a treat. Thank you so much!
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,140
Members
448,551
Latest member
Sienna de Souza

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