简体   繁体   中英

excel 2007 Copy the same range from multiple sheets and paste to current sheet

New to vba, I looked everywhere, tried a few posted macros and modified them for me but nothing ever works perfect and I'm getting frustrated, Help. I need to copy a range of values from multiple Sheets and paste those ranges in one sheet. The first sheet (Totals) will have the macro (as a button). Each sheet after sheet 1, represents an employee so the name of each sheet is their name. The number of sheets will vary from time to time as employees come and go. The range I need to copy is the same for all the employees, (N5:V400). Although the number of rows which contain values in that range will vary from employee to employee. I also need to copy the employees last name in each sheet(cell Q2) and paste it as the leading cell for each row that gets pasted into the Totals Sheet.

So when the Macro runs, Cell Q2(Name) from each employee sheet and any values in range N5:V500 get pasted into the Totals sheet Range A3:J5000 (there are two header rows). The name needs to the first cell of every row that gets pasted for each employee.

I'm sure this is a simple code, but then again I am certainly not qualified to say. Thanks to all who can help.
在此处输入图片说明

Here, try this:

Tried and Tested:

Option Explicit
Sub test()

Dim ws As Worksheet, wsTotals As Worksheet
Dim lrow As Long

Set wsTotals = ThisWorkbook.Sheets("Totals")

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Totals" Then
        lrow = ws.Range("N" & Rows.Count).End(xlUp).Row
        If lrow > 4 Then
            ws.Range("N5:V" & lrow).Copy wsTotals.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            ws.Range("Q2").Copy wsTotals.Range(wsTotals.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Address, _
                wsTotals.Range("A" & Rows.Count).End(xlUp).Offset(lrow - 4, 0).Address)
        End If
    End If
Next ws

End Sub

This should do it.
Hope this works for you.
It's workning but, haven't have time to do a lot of test.

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