Paste different values on different cells

Question

I have a main worksheet called "x" and other sheets named "sheet1" "sheet2" "sheet3"... etc

On the sheets 1,2,3.. the data is placed in colums. I want to copy the values from the cells B3 , B183 , B363 , B603 and paste the data into the main sheet called "X" but on different cells

For each data from one sheet i want to paste the values into the main sheet "x" , after this step is done i want the same thing for sheet 1 , sheet 2 ...

But i want to not overwrite the first copied cell and go to another cell

I have done this code :

 Sub resizingColumns(ws As Worksheet)

    With ws

ws.Range("B3").Copy Destination:=Worksheets("x").Range("M5")
ws.Range("B183").Copy Destination:=Worksheets("x").Range("N5")
ws.Range("B363").Copy Destination:=Worksheets("x").Range("O5")
ws.Range("B603").Copy Destination:=Worksheets("x").Range("P5")


    End With
End Sub

Private Sub CommandButton2_Click()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        Call resizingColumns(ws)
    Next
End Sub

thanks

If i have 3 sheets I want to paste the data from each one in one row/column like

       M     N      O      P
5     22    33     44     55   (data from sheet1)
6     11    22     33     33   (data from sheet2)
7     11    22     11     22   (data from sheet3)

Answer 1

Perhaps find the first blank row in column M and use that rather than hard-coding 5.

Sub resizingColumns(ws As Worksheet)

Dim r As Long

r = Worksheets("x").Range("M" & Rows.Count).End(xlUp).Row + 1

With ws
    .Range("B3").Copy Destination:=Worksheets("x").Range("M" & r)
    .Range("B183").Copy Destination:=Worksheets("x").Range("N" & r)
    .Range("B363").Copy Destination:=Worksheets("x").Range("O" & r)
    .Range("B603").Copy Destination:=Worksheets("x").Range("P" & r)
End With

End Sub

---

Calling code

Private Sub CommandButton2_Click()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "x" Then resizingColumns ws
    Next
End Sub

Answer 2

Ok , this code is working fine :)

Sub resizingColumns(ws As Worksheet)



Dim wb As Workbook

Dim wsDest As Worksheet
Dim rCell As Range
Dim aData() As Variant
Dim sCells As String
Dim i As Long, j As Long

Set wb = ActiveWorkbook
Set wsDest = wb.Sheets("x")
sCells = "B3,B183,B363,b603"

ReDim aData(1 To wb.Sheets.Count - 1, 1 To wsDest.Range(sCells).Cells.Count)

i = 0
For Each ws In wb.Sheets
    If ws.Name <> wsDest.Name Then
        i = i + 1
        j = 0
        For Each rCell In ws.Range(sCells).Cells
            j = j + 1
            aData(i, j) = rCell.Value
        Next rCell
    End If
Next ws

wsDest.Range("M5").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData
End Sub

Calling code

Private Sub CommandButton2_Click()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "x" Then resizingColumns ws
Next
End Sub