Access VBA-Copy paste special with the format

Asatoma Sadgamaya
Asatoma Sadgamaya used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Dale FyeOwner, Dev-Soln LLC
Most Valuable Expert 2014
Top Expert 2010

Commented:
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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Author

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
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
The code assumes that "aaaa.xlsx" is open.

Author

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 LLC
Most Valuable Expert 2014
Top Expert 2010

Commented:
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

Author

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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Author

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 Officer

Commented:
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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Author

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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Author

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
Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
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

Mark EdwardsChief Technology Officer

Commented:
Not sure what "line 4" is ("Dim objSheet As Excel.Worksheet"?), but glad you got it working....
Mark EdwardsChief Technology Officer

Commented:
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 Officer

Commented:
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.

Author

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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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 Officer

Commented:
@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... :-(

Author

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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Author

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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.

Author

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 dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial