Copy the same row from multiples sheets into one specified sheet

Viewed 28

I'm pretty new to VBA and I'm having trouble writing a macro that copies a specified row from all sheets in a workbook into a single, specified worksheet. I've tried looking at other examples of people with the same problem but I can't seem to get my code to work. Here's what I have:

Sub copyrow()
Dim Nrow As Long
Dim Nsheet As Long
Dim ms As Worksheet
Dim i As Long

Set ms = Sheets("All Copper Data")

Nrow = 3
Nsheet = Worksheets.Count


For i = 1 To Nsheet
   Sheets(i).Cells(Nrow, 1).EntireRow.Copy Destination:=Sheets("ms").Cells(i, 1)
Next i
End Sub


I have a bunch of sheets (at the moment, there are 14 sheets I want to collect data from, but there will be more which is why I have Nsheets as worksheets.count). I want to take row 3 from all of the sheets and consolidate them onto a sheet named "All Copper Data"

I'm getting subscript out of range errors. How do I go about fixing this?

2 Answers

ms is a worksheet object, so you would copy to it like this.

For i = 1 To Nsheet
   Sheets(i).Cells(Nrow, 1).EntireRow.Copy Destination:=ms.Cells(i, 1)
Next i

Copy One Row from Multiple Worksheets

s - Source (read from)
d - Destination (written to)

Option Explicit

Sub copyOneRow()
    
    Const dName As String = "All Copper Data"
    Const dFirst As Long = 1
    Const sRow As Long = 3
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dRow As Long: dRow = dFirst
    
    Application.ScreenUpdating = False
    
    Dim sws As Worksheet
    For Each sws In wb.Worksheets
        If StrComp(sws.Name, dName, vbTextCompare) <> 0 Then
            sws.Rows(sRow).Copy Destination:=dws.Rows(dRow)
            dRow = dRow + 1
        End If
    Next sws

    Application.ScreenUpdating = True

End Sub
Related