Access VBA-Copy paste special with the format

Hi,

It would be great if someone could help me out with following query.

I am looking for MS Access VBA script which can copy range of cells (A1:S35) from a spreadsheet(sheet name: aaa) from one workbook(aaaa.xlsxs) and paste (paste special with format) on to another workbook(bbbb.xlsx) spreadsheet (sheet name :aaa).

Thank you
A
Asatoma SadgamayaAnalystAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Dale FyeOwner, Dev-Soln LLCCommented:
Have you tried going to Excel and recording a Macro to perform that action?

Then copy the Excel Macro into your Access application.
Martin LissOlder than dirtCommented:
Sub CopyPaste()
Dim wbSource As Workbook
Dim wbDest As Workbook

Set wbSource = Workbooks("aaaa.xlsx")
Set wbDest = Workbooks("bbbb.xlsx")

wbSource.Sheets("aaa").Range("A1:S35").Copy
wbDest.Sheets("aaa").Range("A1:S35").PasteSpecial Paste:=xlPasteAllUsingSourceTheme

End Sub

Open in new window

Asatoma SadgamayaAnalystAuthor Commented:
hi Martin,

I got subscript out of range

Sub CopyPaste()
Dim wbSource As Workbook
Dim wbDest As Workbook

Set wbSource = Workbooks("aaaa.xlsx")------>subscript out of range
Set wbDest = Workbooks("bbbb.xlsx")

wbSource.Sheets("aaa").Range("A1:S35").Copy
wbDest.Sheets("aaa").Range("A1:S35").PasteSpecial Paste:=xlPasteAllUsingSourceTheme

End Sub

Thank you
Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

Martin LissOlder than dirtCommented:
The code assumes that "aaaa.xlsx" is open.
Asatoma SadgamayaAnalystAuthor Commented:
Hi Dale, this is what I get when I use switch on macro on excel

Sub Macro4()

    Range("A1:S35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("bbbb.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Windows("aaaa.xlsx").Activate
End Sub

Open in new window


Thank you
Dale FyeOwner, Dev-Soln LLCCommented:
Martin is the expert on Excel, use his code.

You would need to change the name of the workbooks and the worksheets in Martin's example to coincide with the workbook and sheet names in your Excel workbook.

I use that method as a start point for all things related to Excel automation.  I then modify my Access code to remove references to "SELECTION" and "SELECT" which should really not be used as they allow user interaction in the spreadsheet to interfere with your code.  Instead use, the Workbook, Worksheet, Range and Cell objects to manipulate your data in Excel.

dale
Asatoma SadgamayaAnalystAuthor Commented:
Hi Martin, I closed and run the code again, but same error pops up!! Also, for safe side I deleted excel from Task manager as well
Martin LissOlder than dirtCommented:
If either of the two workbooks are closed, then open them with something like

Workbooks.Open ("C:\Full path to workbook\aaaa.xlsx")
Set wbSource = ActiveWorkbook
wbSource.Activate

Open in new window


And when you paste code into a post, it's a good idea to select the code and then click the CODE button.
2019-03-06_09-50-18.png
Asatoma SadgamayaAnalystAuthor Commented:
Hi Martin, I have done something like below. Can you please have a look, I have closed all the excel workbooks and still showing subscript out of range error

Public Sub CopyPaste()
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim ObjExcel

    Set ObjExcel = CreateObject("Excel.Application")
    ObjExcel.Visible = False ' I don't want to open any of the excel files.
    Set wbSource = Workbooks("C:\Usersabcd\aaaa.xlsx")
    Set wbDest = Workbooks("C:\Usersabcd\bbbb.xlsx")
    
    wbSource.Sheets("aaaa").Range("A1:S35").Copy
    wbDest.Sheets("aaaa").Range("A1:S35").PasteSpecial Paste:=xlPasteFormats ' because I don't want the formulas to be coped
    wbDest.Sheets("aaaa").Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' because I don't want the formulas to be coped
    
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    ObjExcel.Quit
    
    Set ObjExcel = Nothing
    Set ObjSheet = Nothing
    Set wbSource = Nothing
    Set wbDest = Nothing
End Sub

Open in new window


Thank you
A
Mark EdwardsChief Technology OfficerCommented:
Either the workbook names or sheet names don't exists, or, try activating the target workbook and worksheets before trying to do any pasting, etc.
I know we are referencing objects instead of relative "active" parts of Excel, but simply activating a workbook and worksheet prior to trying to do anything with it has been the solution in the past.

Before beating your head against the wall, at least try it.  It has worked for others....
Martin LissOlder than dirtCommented:
I could be wrong but I believe you have to open the workbooks.

Public Sub CopyPaste()
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim ObjExcel
Dim ObjSheet

    Set ObjExcel = CreateObject("Excel.Application")
    
    ObjExcel.Visible = False ' I don't want to open any of the excel files.

    Workbooks.Open ("C:\Usersabcd\bbbb.xlsx")
    Set wbDest = ActiveWorkbook
    
    Workbooks.Open "C:\Usersabcd\aaaa.xlsx"
    Set wbSource = ActiveWorkbook
    
    wbSource.Sheets("aaaa").Range("A1:S35").Copy
    wbDest.Sheets("aaaa").Range("A1:S35").PasteSpecial Paste:=xlPasteFormats ' because I don't want the formulas to be coped
    wbDest.Sheets("aaaa").Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' because I don't want the formulas to be coped
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    ObjExcel.Quit
    
    Set ObjExcel = Nothing
    Set ObjSheet = Nothing
    Set wbSource = Nothing
    Set wbDest = Nothing
End Sub

Open in new window

Asatoma SadgamayaAnalystAuthor Commented:
Hi , can you please let me know how can i save and close the first workbook(aaaa.xlsx) on the below code.

Public Sub CopyPaste()
Dim ObjExcel

    Set ObjExcel = CreateObject("Excel.Application")
    ObjExcel.Visible = False
    ObjExcel.Workbooks.Open "C:\aaaa.xlsx"
    Set ObjSheet = ObjExcel.ActiveWorkbook.Worksheets("aaa")
    ObjSheet.Activate
    ObjSheet.Range("A1:S35").Copy
    
    ObjExcel.Workbooks.Open "C:\bbbb.xlsx"
    Set ObjSheet = ObjExcel.ActiveWorkbook.Worksheets("aaa")
    ObjSheet.Activate
    ObjSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteFormats
    ObjSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    With ObjSheet
        .Columns("G:G").Group
        .Columns("K:K").Group
        .Columns("O:O").Group
        .Columns("S:S").Group
    End With
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    ObjExcel.Quit
    
    Set ObjExcel = Nothing
    Set ObjSheet = Nothing
End Sub

Open in new window

Martin LissOlder than dirtCommented:
Try this. I added line 3, 9 and 31.

Public Sub CopyPaste()
Dim ObjExcel
Dim wb As Excel.Workbook 

    Set ObjExcel = CreateObject("Excel.Application")
    ObjExcel.Visible = False
    ObjExcel.Workbooks.Open "C:\aaaa.xlsx"
    
    Set wb = ActiveWorkbook 
    
    Set ObjSheet = ObjExcel.ActiveWorkbook.Worksheets("aaa")
    ObjSheet.Activate
    ObjSheet.Range("A1:S35").Copy
    
    ObjExcel.Workbooks.Open "C:\bbbb.xlsx"
    Set ObjSheet = ObjExcel.ActiveWorkbook.Worksheets("aaa")
    ObjSheet.Activate
    ObjSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteFormats
    ObjSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    With ObjSheet
        .Columns("G:G").Group
        .Columns("K:K").Group
        .Columns("O:O").Group
        .Columns("S:S").Group
    End With
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    
    wb.Close SaveChanges:=True 
    
    ObjExcel.Quit
    
    Set ObjExcel = Nothing
    Set ObjSheet = Nothing
End Sub

Open in new window

Asatoma SadgamayaAnalystAuthor Commented:
Hi Martin, please note that above code can not find bbbb.xlsx though it exists at right place.
Also, this code is to copy from one excel tab (aaa on aaaa.xlsx)) to another(aaa on bbbb.xlsx). On aaaa.xlsx I have 10 tabs which needs to copy to exactly same tabs on bbbb.xlsx.

Ta
Martin LissOlder than dirtCommented:
I added line 4 and it works perfectly for me (from Excel).
Public Sub CopyPaste()
Dim ObjExcel
Dim wb As Excel.Workbook
Dim objSheet As Excel.Worksheet

    Set ObjExcel = CreateObject("Excel.Application")
    ObjExcel.Visible = False
    ObjExcel.Workbooks.Open "C:\aaaa.xlsx"
    
    Set wb = ActiveWorkbook
    
    Set objSheet = ObjExcel.ActiveWorkbook.Worksheets("aaa")
    objSheet.Activate
    objSheet.Range("A1:S35").Copy
    
    ObjExcel.Workbooks.Open "C:\bbbb.xlsx"
    Set objSheet = ObjExcel.ActiveWorkbook.Worksheets("aaa")
    objSheet.Activate
    objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteFormats
    objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    With objSheet
        .Columns("G:G").Group
        .Columns("K:K").Group
        .Columns("O:O").Group
        .Columns("S:S").Group
    End With
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    
    wb.Close SaveChanges:=True
    
    ObjExcel.Quit
    
    Set ObjExcel = Nothing
    Set objSheet = Nothing
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Mark EdwardsChief Technology OfficerCommented:
Not sure what "line 4" is ("Dim objSheet As Excel.Worksheet"?), but glad you got it working....
Mark EdwardsChief Technology OfficerCommented:
p.s. Just curious.... If you remmed-out the "objSheet.Activate" lines, would it still work?  Just trying to verify that you still need to activate an object  even though you have specific object variables.  (I think it's an "Excel" thing.....)
Mark EdwardsChief Technology OfficerCommented:
p.s.s  the line "Set wb = ActiveWorkbook" is one way to set a workbook object variable (using relative reference), but a function that finds or opens a workbook and returns a workbook object will do the same thing.

Perhaps your original code to set the workbook object did not set a workbook, but left wb still Nothing?  If wb was set to nothing when you tried to use it, that would really blow things up too.
Asatoma SadgamayaAnalystAuthor Commented:
Hi Martin,

Your code worked for me, thank you. I will mention it as my answer. One question, in order to copy paste 10 worksheets, do I need to  create 10 similar codes with different sheet names on them? or is it possible to create a all in one script?

Thank you
A
Martin LissOlder than dirtCommented:
Are they all from the aaaa workbook?
Do you want to do this more than one time?
Will the sheet names always be the same?
Will the ranges be the same?

And before we go on, please accept the answer that worked for you.
Mark EdwardsChief Technology OfficerCommented:
@Martin:  Sorry, I see now it was you who pasted the code with the "It worked for me" phrase.  I thought It was from the author.  That's what I get for not scrolling far enough up... :-(
Asatoma SadgamayaAnalystAuthor Commented:
Hi Martin, Please find answers to your questions

Are they all from the aaaa workbook?  Yes
Do you want to do this more than one time? Yes
Will the sheet names always be the same? No, aaa, bbb,ccc,ddd....
Will the ranges be the same? Yes

Thanks
Martin LissOlder than dirtCommented:
Okay then try this modification,
Public Sub CopyPaste()
Dim ObjExcel
Dim wb As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim strName As String

    Set ObjExcel = CreateObject("Excel.Application")
    ObjExcel.Visible = False
    ObjExcel.Workbooks.Open "C:\aaaa.xlsx"
    
    Set wb = ActiveWorkbook
    
    strName = "Start"
    Do Until strName = ""
        strName = InputBox("Please enter a name to copy")
        If strName > "" Then
            Set objSheet = ObjExcel.ActiveWorkbook.Worksheets(strName)
            objSheet.Activate
            objSheet.Range("A1:S35").Copy
            
            ObjExcel.Workbooks.Open "C:\bbbb.xlsx"
            Set objSheet = ObjExcel.ActiveWorkbook.Worksheets(strName)
            objSheet.Activate
            objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteFormats
            objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
            With objSheet
                .Columns("G:G").Group
                .Columns("K:K").Group
                .Columns("O:O").Group
                .Columns("S:S").Group
            End With
        End If
    Loop
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    
    wb.Close SaveChanges:=True
    
    ObjExcel.Quit
    
    Set ObjExcel = Nothing
    Set objSheet = Nothing
End Sub

Open in new window

Asatoma SadgamayaAnalystAuthor Commented:
Thanks for your script  Martin,

Is it possible the code finds out the sheets rather than a manual entry? Or I can supply all the sheet names somewhere inside the code.

Thank you
Martin LissOlder than dirtCommented:
Public Sub CopyPaste()
Dim ObjExcel
Dim wb As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim colSheetNames As New Collection
Dim sht As Excel.Worksheet
Dim lngSheet As Long

    Set ObjExcel = CreateObject("Excel.Application")
    ObjExcel.Visible = False
    ObjExcel.Workbooks.Open "C:\aaaa.xlsx"
    
    Set wb = ActiveWorkbook
    
    For Each sht In ObjExcel.Workbooks("aaaa.xlsx").Sheets
        colSheetNames.Add sht.Name
    Next
    
    For lngSheet = 1 To colSheetNames.Count
        If vbYes = MsgBox("Copy sheet " & colSheetNames(lngSheet) & "?", vbYesNo, "Copy Sheets") Then
            Set objSheet = ObjExcel.ActiveWorkbook.Worksheets(colSheetNames(lngSheet))
            objSheet.Activate
            objSheet.Range("A1:S35").Copy
            
            ObjExcel.Workbooks.Open "C:\bbbb.xlsx"
            Set objSheet = ObjExcel.ActiveWorkbook.Worksheets(colSheetNames(lngSheet))
            objSheet.Activate
            objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteFormats
            objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
            With objSheet
                .Columns("G:G").Group
                .Columns("K:K").Group
                .Columns("O:O").Group
                .Columns("S:S").Group
            End With
        End If
    Next
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    
    wb.Close SaveChanges:=True
    
    ObjExcel.Quit
    
    Set ObjExcel = Nothing
    Set objSheet = Nothing
End Sub

Open in new window

If you wanted to copy all the sheets in aaaa, or if you always want to copy the same ones, or if the names of the ones you want to copy have some pattern the code can recognize, you wouldn't even need to be asked.
Asatoma SadgamayaAnalystAuthor Commented:
Thank for your reply Martin,

Please note, I am getting message box, asking do i need to copy each sheet. Also, when I run the code I am getting error message saying that bbbb.xlsx is already opened. Actually it is not.

Thank you
A
Martin LissOlder than dirtCommented:
Public Sub CopyPaste()
Dim ObjExcel
Dim wb As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim colSheetNames As New Collection
Dim sht As Excel.Worksheet
Dim lngSheet As Long

    Application.ScreenUpdating = False
    
    Set ObjExcel = CreateObject("Excel.Application")
    ObjExcel.Visible = False
    ObjExcel.Workbooks.Open "C:\aaaa.xlsx"
    
    Set wb = ActiveWorkbook
    
    For Each sht In ObjExcel.Workbooks("aaaa.xlsx").Sheets
        colSheetNames.Add sht.Name
    Next
    
    Application.DisplayAlerts = False
    
    For lngSheet = 1 To colSheetNames.Count
        If vbYes = MsgBox("Copy sheet " & colSheetNames(lngSheet) & "?", vbYesNo, "Copy Sheets") Then
            Set objSheet = ObjExcel.ActiveWorkbook.Worksheets(colSheetNames(lngSheet))
            objSheet.Activate
            objSheet.Range("A1:S35").Copy
            
            ObjExcel.Workbooks.Open "C:\bbbb.xlsx"
            Set objSheet = ObjExcel.ActiveWorkbook.Worksheets(colSheetNames(lngSheet))
            objSheet.Activate
            objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteFormats
            objSheet.Range("A1:S35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
            With objSheet
                .Columns("G:G").Group
                .Columns("K:K").Group
                .Columns("O:O").Group
                .Columns("S:S").Group
            End With
        End If
    Next
    
    ObjExcel.ActiveWorkbook.Save
    ObjExcel.ActiveWorkbook.Close
    
    wb.Close SaveChanges:=True
    
    ObjExcel.Quit
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Set ObjExcel = Nothing
    Set objSheet = Nothing
End Sub

Open in new window

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.