Results 1 to 9 of 9

Thread: Copying range to another book in fixed range

  1. #1
    New Member
    Join Date
    Aug 2017
    Posts
    32
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Copying range to another book in fixed range

    Hi

    I've one workbook that contains 31 sheets (1 for each day). I want macro to open source workbook and loop through each sheet and copy range H15:H28 and paste it in active (Target) workbook from B4. I've code that does the job. But I want some change. After pasting in 16 columns i.e. up to Q4, next pasting should start from B20.

    Here is the code

    Sub UtilityConsumption()


    Dim ws As Worksheet
    Dim TargetWb As Workbook
    Dim SourceWb As Workbook
    Range("B4").Activate

    Application.ScreenUpdating = False
    Set TargetWb = ActiveWorkbook
    Set SourceWb = Workbooks.Open("X:\XXX\XXX.xlsm")

    SourceWb.Worksheets("1 April 2019 ").Activate

    For Each ws In Sheets
    Range("H15:H28").Copy

    TargetWb.Activate
    ActiveCell.Offset(0, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    ActiveCell.Offset(0, 1).Range("A1").Select
    SourceWb.Activate

    ActiveSheet.Previous.Select
    On Error GoTo exiterr
    Next ws
    exiterr:

    Application.CutCopyMode = False
    SourceWb.Close


    End Sub

  2. #2
    New Member
    Join Date
    Apr 2019
    Location
    India
    Posts
    46
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copying range to another book in fixed range

    Try this code - though the code could have been optimized, I have tried to just minimally modify your code...
    Code:
    Sub UtilityConsumption()
    
    
    Dim ws As Worksheet
    Dim TargetWb As Workbook
    Dim SourceWb As Workbook
    Range("B4").Activate
    ctr=1
    Application.ScreenUpdating = False
    Set TargetWb = ActiveWorkbook
    Set SourceWb = Workbooks.Open("X:\XXX\XXX.xlsm")
    
    SourceWb.Worksheets("1 April 2019 ").Activate
    
    For Each ws In Sheets
    Range("H15:H28").Copy
    
    TargetWb.Activate
    ActiveCell.Offset(0, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    ctr=ctr+1
    If ctr=17 Then Range("A20").Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    SourceWb.Activate
    
    ActiveSheet.Previous.Select
    On Error GoTo exiterr
    Next ws
    exiterr:
    
    Application.CutCopyMode = False
    SourceWb.Close
    
    
    End Sub
    Last edited by ravisingh; Apr 13th, 2019 at 09:53 PM.

  3. #3
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    2,153
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Copying range to another book in fixed range

    How about:

    Code:
    Sub UtilityConsumption()
        Dim wb1 As Workbook, wb2 As Workbook
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim i As Long, j As Long
        
        Application.ScreenUpdating = False
        Set wb1 = ActiveWorkbook
        Set ws1 = wb1.ActiveSheet
        Set wb2 = Workbooks.Open("X:\XXX\XXX.xlsm")
        
        i = 4
        j = 2
        For Each ws2 In wb2.Sheets
            ws2.Range("H15:H28").Copy
            ws1.Cells(i, j).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            j = j + 1
            If j = 17 Then
                i = 4 + 16
                j = 2
            End If
        Next
        wb2.Close False
        Application.ScreenUpdating = True
        MsgBox "End"
    End Sub
    Regards Dante Amor

  4. #4
    New Member
    Join Date
    Aug 2017
    Posts
    32
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copying range to another book in fixed range

    @ravi

    Its working as I want.
    @DanteAmor

    Code is working fine but not how I want it. I want code to run from right to left on the sheets. We are keeping one sheet each for a day with latest on the left (the first sheet). Your code runs from left to right and so the pasting gets reverse dates. Also I've one extra sheet from previous month to omit. Thats the reason I ask the code to set "01 Apr 2019" as starting sheet and run on previous sheets.
    Last edited by dinunan; Apr 14th, 2019 at 03:47 PM.

  5. #5
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    2,153
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Copying range to another book in fixed range

    Try this:

    Code:
    Sub UtilityConsumption()
        Dim wb1 As Workbook, wb2 As Workbook
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim i As Long, j As Long, n As Long
        
        Application.ScreenUpdating = False
        Set wb1 = ActiveWorkbook
        Set ws1 = wb1.ActiveSheet
        Set wb2 = Workbooks.Open("X:\XXX\XXX.xlsm")
    
    
        i = 4
        j = 2
        For n = wb2.Worksheets("1 April 2019 ").Index To 1 Step -1
            Set ws2 = wb2.Sheets(n)
            ws2.Range("H15:H28").Copy
            ws1.Cells(i, j).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            j = j + 1
            If j = 17 Then
                i = 4 + 16
                j = 2
            End If
        Next
        wb2.Close False
        Application.ScreenUpdating = True
        MsgBox "End"
    End Sub
    Regards Dante Amor

  6. #6
    New Member
    Join Date
    Aug 2017
    Posts
    32
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copying range to another book in fixed range

    Quote Originally Posted by DanteAmor View Post
    Try this:

    Code:
    Sub UtilityConsumption()
        Dim wb1 As Workbook, wb2 As Workbook
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim i As Long, j As Long, n As Long
        
        Application.ScreenUpdating = False
        Set wb1 = ActiveWorkbook
        Set ws1 = wb1.ActiveSheet
        Set wb2 = Workbooks.Open("X:\XXX\XXX.xlsm")
    
    
        i = 4
        j = 2
        For n = wb2.Worksheets("1 April 2019 ").Index To 1 Step -1
            Set ws2 = wb2.Sheets(n)
            ws2.Range("H15:H28").Copy
            ws1.Cells(i, j).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            j = j + 1
            If j = 17 Then
                i = 4 + 16
                j = 2
            End If
        Next
        wb2.Close False
        Application.ScreenUpdating = True
        MsgBox "End"
    End Sub
    Code halts with yellow highlight on the line
    For n = wb2.Worksheets("1 April 2019 ").Index To 1 Step -1

    The source file is opened and "10 Apr 2019" sheet is active.
    and throws Run time error (9) script out of range

  7. #7
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    2,153
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Copying range to another book in fixed range

    In your original code you have a space after 19

    Code:
    SourceWb.Worksheets("1 April 2019 ").Activate
    If that space does not exist then use the following:

    Code:
    Sub UtilityConsumption()
        Dim wb1 As Workbook, wb2 As Workbook
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim i As Long, j As Long, n As Long
        
        Application.ScreenUpdating = False
        Set wb1 = ActiveWorkbook
        Set ws1 = wb1.ActiveSheet
        Set wb2 = Workbooks.Open("X:\XXX\XXX.xlsm")
    
    
    
    
        i = 4
        j = 2
        For n = wb2.Worksheets("1 April 2019").Index To 1 Step -1
            Set ws2 = wb2.Sheets(n)
            ws2.Range("H15:H28").Copy
            ws1.Cells(i, j).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            j = j + 1
            If j = 17 Then
                i = 4 + 16
                j = 2
            End If
        Next
        wb2.Close False
        Application.ScreenUpdating = True
        MsgBox "End"
    End Sub
    it usually happens, that way you experiment and learn more.
    Regards Dante Amor

  8. #8
    New Member
    Join Date
    Aug 2017
    Posts
    32
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copying range to another book in fixed range

    Space was indeed there. I removed those spaces wherever existed and run the code. But this time, after pasting for 15 dates (and not 16 dates) it jumped down.
    Changed the j value from 17 to 18 and now it works as I want it.

    Thanks for the help and advice.

  9. #9
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    2,153
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Copying range to another book in fixed range

    I'm glad to help you. Thanks for the feedback.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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