简体   繁体   中英

Copying data from one column to next empty column in a range

I have a macro which successfully copies data from one column, pastes it into the next empty column in a specific range and then deletes cell contents in another range.

It only works on the open worksheet.

I have tried to add a loop to cycle through a selection of worksheets within the workbook and, whilst the macro runs, it still only performs the procedure on the worksheet that is open.

Can anyone help me to make it run on each of the worksheets listed in the array?

Sub CopyPasteEoY_OtherSubjects()
'
' CopyPaste Macro
'
Dim Sh As Variant                'Sh = All Foundation Subjects sheets
Dim targetRng As Excel.Range
Dim destRng As Excel.Range
Dim objsRng As Excel.Range
Set targetRng = Range("AU4:AU103")
Set destRng = Range("V4:AB103")
Set objsRng = Range("AC4:AT103")

Application.ScreenUpdating = False

For Each Sh In Array("Art", "Computing", "Design Technology", "Geography", "History", "MFL", "Music", "PE", "RE", "Science")
        With destRng
            Set destRng = .Cells(.Columns.Count).End(Excel.xlToLeft).Offset(0, 1).Resize(targetRng.Rows.Count, targetRng.Columns.Count)
                destRng.Value = targetRng.Value
                    With objsRng
                    .ClearContents
                    End With
        End With
Next Sh

Application.ScreenUpdating = True

End Sub

Many thanks.

Give it a try.

Sub CopyPasteEoY_OtherSubjects()
    '
    ' CopyPaste Macro
    '
    Dim Sh As Variant                'Sh = All Foundation Subjects sheets
    Dim targetRng As Excel.Range
    Dim destRng As Excel.Range
    Dim objsRng As Excel.Range

    Application.ScreenUpdating = False

    'Your concept is nothing wrong, just remember to specify the certain sheet you are dealing with
    For Each Sh In Array("Art", "Computing", "Design Technology", "Geography", "History", "MFL", "Music", "PE", "RE", "Science")

        With Worksheets(Sh)
            Set targetRng = .Range("AU4:AU103")
            Set destRng = .Range("V4:AB103")
            Set objsRng = .Range("AC4:AT103")
        End With

        With destRng
            'This part is weird, you should avoid changing the main object itself in the with statement
            Set destRng = .Cells(.Columns.Count).End(Excel.xlToLeft).Offset(0, 1).Resize(targetRng.Rows.Count, targetRng.Columns.Count)
            'destRng.Address and .Address are different now, be aware
            destRng.Value = targetRng.Value
            objsRng.ClearContents
        End With

    Next Sh

    Application.ScreenUpdating = True

End Sub

Please let me know if I misunderstood anything.

Set rng = Range("A1") is actually Set rng = ActiveSheet.Range("A1") . Therefore when you need to do something with the other sheet, you have to restrict it to the sheet by

Set rng = Worksheets(B).Range("A1")

Or you can activate the sheet before you setting the rng object like

Worksheets(B).Activate
Set rng = Range("A1")

However this is not an efficient way, since Activate is a resource-wasting job.

And note that, even if you activated other sheet, a range object will still remain the same parent before it is re-set again. Check codes below.

Worksheets(A).Activate
Set rng = Range("A1")        'now it belongs to Worksheets(A)
Worksheets(B).Activate
Debug.Print rng.Parent.Name  'Worksheet(A) will appear
Set rng = Range("A1")        'now it belongs to Worksheets(B)
Debug.Print rng.Parent.Name  'it is Worksheet(B) now

Secondary the With part, you can edit any property of the main object as you wish but not set it to another object. Check the codes.

Dim rng As Range
Set rng = Range("A1")
With rng
    Set rng = Range("B100")
    Debug.Print rng.Address     'gives $B$100
    Debug.Print .Address        'gives the original one, $A$1
End With

It will be confusing so better not to do this.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM