Looping through sheets to select range, copy and paste

[rafikarp]

Hi,

I am trying to write a macro that will loop through all sheets in my workbook except one (entitled "List"), and copy the same range in each sheet (B1:B6) and then paste into the sheet "List" one under the other using the NextRow method.

I have browsed some previous posts on the same topic and tried to adapt them to my needs but I am so far unsuccessful. The loop is not working. This is what I have so far. Any help would be much appreciated. Thanks!

Dim wst As Worksheet

Sheets(1).Select

For Each wst In Worksheets

Select Case wst.Name
Case "List" 'Do Nothing
Case Else

Range("B1:B6").Select
Selection.Copy
Sheets("List").Select
Range("I2:I7").Select
ActiveSheet.Paste

NextRow = Sheets("List").Range("A" & Rows.Count).End(xlUp).Row + 1

Cells(NextRow, 1) = Sheets("List").Range("I2")
Cells(NextRow, 2) = Sheets("List").Range("I3")
Cells(NextRow, 3) = Sheets("List").Range("I4")
Cells(NextRow, 4) = Sheets("List").Range("I5")
Cells(NextRow, 5) = Sheets("List").Range("I6")
Cells(NextRow, 6) = Sheets("List").Range("I7")

Range("I2:I7").ClearContents

End Select
Next wst

End Sub

 

[VoG]

Try

Sub Cpy()
Dim ws As Worksheet, NR As Long
NR = 2
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "List" Then
        ws.Range("B1:B6").Copy Destination:=Sheets("List").Range("I" & NR)
        NR = NR + 6
    End If
Next ws
End Sub

 

[rafikarp]

Thanks. I was able to adapt this for my needs.