Consulting

Results 1 to 3 of 3

Thread: Copy Data from a Workbook with multiple Worksheets to another Workbook

  1. #1

    Copy Data from a Workbook with multiple Worksheets to another Workbook

    Hi All!
    I created a VBA macro to copy data from specific worksheets in a workbook to another workbook with the same worksheet names. I am having trouble looping through the workbook to copy data from each of the worksheets. I am not sure where I should place the "For" and "Next" statement. Also, I do not think the code I have for looping through the workbook is the correct code. There are 12 worksheets (i.e. Jan13, Feb13, Mar13, etc.). The worksheets names will be the same on both the source and target workbooks.

    I am getting an error (I bold the statement below) where it states the "Object does not support this property or method".

    Below is my VBA Code.

    Any input would be very appreciated. Thanks in advance for your help.

    - Ron -

    Sub Copy_Data_Items()


    ' Copy items from Source Workbook to Target Workbook.


    If MsgBox("Do You Want to Copy Data?", vbYesNo + vbDefaultButton2) = vbNo Then
    End
    End If


    If MsgBox("Are you Sure?", vbYesNo + vbDefaultButton2) = vbNo Then
    End
    End If


    Dim wbTarget As Workbook 'workbook where the data is to be pasted
    Dim wbSource As Workbook 'workbook from where the data is to copied
    Dim strSourceFile As String
    Dim strTargetFile As String


    strSourceFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13old.xlsm"
    strTargetFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13new.xlsm"


    Dim i As Long

    'Set to the current active workbook (the source book)
    Set wbSource = ActiveWorkbook

    'Open a Target workbook
    Set wbTarget = Workbooks.Open(strTargetFile)

    For i = 1 To 12
    Sheets(i + 1).Select


    'Clear existing values from target book


    Range("C12:G35") = ClearContents
    Range("C38:G52") = ClearContents
    Range("B60:G109") = ClearContents
    Range("B116:G215") = ClearContents
    Range("D216:G216") = ClearContents
    Range("I66:O85") = ClearContents
    Range("L086:O86") = ClearContents
    Range("I94:O108") = ClearContents
    Range("L109:O109") = ClearContents
    Range("I118:O126") = ClearContents
    Range("L127:O127") = ClearContents
    Range("I135:O144") = ClearContents
    Range("I153:O160") = ClearContents
    Range("L161:O161") = ClearContents
    Range("I169:O178") = ClearContents
    Range("I186:O215") = ClearContents
    Range("L216:O216") = ClearContents


    'Select cell C12 on the target book
    wbTarget.Range("C12:G35").Select

    'Activate the source book
    wbSource.Activate


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("C12:G35").Copy


    'Paste the data on the target book
    wbTarget.Range("C12").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("C38:G52").Copy


    'Paste the data on the target book
    wbTarget.Range("C38").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("B60:G109").Copy


    'Paste the data on the target book
    wbTarget.Range("B60").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("B116:G216").Copy


    'Paste the data on the target book
    wbTarget.Range("B116").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("I66:O86").Copy


    'Paste the data on the target book
    wbTarget.Range("I66").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("I94:O109").Copy


    'Paste the data on the target book
    wbTarget.Range("I94").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("I118:O127").Copy


    'Paste the data on the target book
    wbTarget.Range("I118").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("I135:O144").Copy


    'Paste the data on the target book
    wbTarget.Range("I135").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("I153:O161").Copy


    'Paste the data on the target book
    wbTarget.Range("I153").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("I169:O178").Copy


    'Paste the data on the target book
    wbTarget.Range("I169").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False


    'Copy the range from source book
    wbSource.Range("I186:O216").Copy


    'Paste the data on the target book
    wbTarget.Range("I186").PasteValues


    'Clear anything on clipboard to maximize available memory
    Application.CutCopyMode = False




    'Save the target book
    wbTarget.Save


    'Close the workbook
    wbTarget.Close


    'Activate the source book again
    wbSource.Activate

    'Clear memory
    Set wbTarget = Nothing
    Set wbSource = Nothing


    Range("A1").Select

    PctDone = i / 12
    With UserForm3
    .FrameProgress.Caption = VBA.Format(PctDone, "0%")
    .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
    End With
    ' The DoEvents statement is responsible for the form updating
    DoEvents

    Next i

    Unload UserForm3

    End Sub

  2. #2
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    welcome to VBAX.

    please use CODE tags when posting codes. clicking the # button in quick reply window will insert these tags for you.



    assuming same worksheets have same sheet indexes in both workbooks and ranges listed will be copied to corresponding ranges in target workbook... try this.

    Sub Copy_Data_Items()
    ' Copy items from Source Workbook to Target Workbook.
    
    
        Dim wbTarget As Workbook 'workbook where the data is to be pasted
        Dim wbSource As Workbook 'workbook from where the data is to copied
        Dim strSourceFile As String
        Dim strTargetFile As String
        Dim i As Long
        
        strSourceFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13old.xlsm"
        strTargetFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13new.xlsm"
        
        If MsgBox("Do You Want to Copy Data?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
        If MsgBox("Are you Sure?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
        
        Set wbSource = ActiveWorkbook
        Set wbTarget = Workbooks.Open(strTargetFile)
        
        For i = 1 To 12
            With wbTarget
                .Sheets(i + 1).Range("C12:G35") = wbSource.Sheets(i + 1).Range("C12:G35")
                .Sheets(i + 1).Range("C38:G52") = wbSource.Sheets(i + 1).Range("C38:G52")
                .Sheets(i + 1).Range("B60:G109") = wbSource.Sheets(i + 1).Range("B60:G109")
                .Sheets(i + 1).Range("B116:G215") = wbSource.Sheets(i + 1).Range("B116:G215")
                .Sheets(i + 1).Range("D216:G216") = wbSource.Sheets(i + 1).Range("D216:G216")
                .Sheets(i + 1).Range("I66:O85") = wbSource.Sheets(i + 1).Range("I66:O85")
                .Sheets(i + 1).Range("L086:O86") = wbSource.Sheets(i + 1).Range("L086:O86")
                .Sheets(i + 1).Range("I94:O108") = wbSource.Sheets(i + 1).Range("I94:O108")
                .Sheets(i + 1).Range("L109:O109") = wbSource.Sheets(i + 1).Range("L109:O109")
                .Sheets(i + 1).Range("I118:O126") = wbSource.Sheets(i + 1).Range("I118:O126")
                .Sheets(i + 1).Range("L127:O127") = wbSource.Sheets(i + 1).Range("L127:O127")
                .Sheets(i + 1).Range("I135:O144") = wbSource.Sheets(i + 1).Range("I135:O144")
                .Sheets(i + 1).Range("I153:O160") = wbSource.Sheets(i + 1).Range("I153:O160")
                .Sheets(i + 1).Range("L161:O161") = wbSource.Sheets(i + 1).Range("L161:O161")
                .Sheets(i + 1).Range("I169:O178") = wbSource.Sheets(i + 1).Range("I169:O178")
                .Sheets(i + 1).Range("I186:O215") = wbSource.Sheets(i + 1).Range("I186:O215")
                .Sheets(i + 1).Range("L216:O216") = wbSource.Sheets(i + 1).Range("L216:O216")
            End With
        Next i
        
        wbTarget.Close True
    
    
    End Sub
    PS: lines related with userform are omitted. i dont see the original file.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  3. #3
    Hi mancubus!
    Thank you for your help with my code. I appreciate your time and effort with helping me.

    I copied over your code and ran the macro and nothing was copied over from the "source" file to the "target" file. It did loop through all of the worksheets as coded but none of the data copied over. The code you provided should work but I am not sure why it is not working.

    Again, thank you for providing the code. I will continue to work on it. Thanks!

    - Ron -


    Quote Originally Posted by mancubus View Post
    welcome to VBAX.

    please use CODE tags when posting codes. clicking the # button in quick reply window will insert these tags for you.



    assuming same worksheets have same sheet indexes in both workbooks and ranges listed will be copied to corresponding ranges in target workbook... try this.

    Sub Copy_Data_Items()
    ' Copy items from Source Workbook to Target Workbook.
    
    
        Dim wbTarget As Workbook 'workbook where the data is to be pasted
        Dim wbSource As Workbook 'workbook from where the data is to copied
        Dim strSourceFile As String
        Dim strTargetFile As String
        Dim i As Long
        
        strSourceFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13old.xlsm"
        strTargetFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13new.xlsm"
        
        If MsgBox("Do You Want to Copy Data?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
        If MsgBox("Are you Sure?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
        
        Set wbSource = ActiveWorkbook
        Set wbTarget = Workbooks.Open(strTargetFile)
        
        For i = 1 To 12
            With wbTarget
                .Sheets(i + 1).Range("C12:G35") = wbSource.Sheets(i + 1).Range("C12:G35")
                .Sheets(i + 1).Range("C38:G52") = wbSource.Sheets(i + 1).Range("C38:G52")
                .Sheets(i + 1).Range("B60:G109") = wbSource.Sheets(i + 1).Range("B60:G109")
                .Sheets(i + 1).Range("B116:G215") = wbSource.Sheets(i + 1).Range("B116:G215")
                .Sheets(i + 1).Range("D216:G216") = wbSource.Sheets(i + 1).Range("D216:G216")
                .Sheets(i + 1).Range("I66:O85") = wbSource.Sheets(i + 1).Range("I66:O85")
                .Sheets(i + 1).Range("L086:O86") = wbSource.Sheets(i + 1).Range("L086:O86")
                .Sheets(i + 1).Range("I94:O108") = wbSource.Sheets(i + 1).Range("I94:O108")
                .Sheets(i + 1).Range("L109:O109") = wbSource.Sheets(i + 1).Range("L109:O109")
                .Sheets(i + 1).Range("I118:O126") = wbSource.Sheets(i + 1).Range("I118:O126")
                .Sheets(i + 1).Range("L127:O127") = wbSource.Sheets(i + 1).Range("L127:O127")
                .Sheets(i + 1).Range("I135:O144") = wbSource.Sheets(i + 1).Range("I135:O144")
                .Sheets(i + 1).Range("I153:O160") = wbSource.Sheets(i + 1).Range("I153:O160")
                .Sheets(i + 1).Range("L161:O161") = wbSource.Sheets(i + 1).Range("L161:O161")
                .Sheets(i + 1).Range("I169:O178") = wbSource.Sheets(i + 1).Range("I169:O178")
                .Sheets(i + 1).Range("I186:O215") = wbSource.Sheets(i + 1).Range("I186:O215")
                .Sheets(i + 1).Range("L216:O216") = wbSource.Sheets(i + 1).Range("L216:O216")
            End With
        Next i
        
        wbTarget.Close True
    
    
    End Sub
    PS: lines related with userform are omitted. i dont see the original file.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •