Вставьте разные значения в разные ячейки

Question

У меня есть главный рабочий лист с именем "x" и другие листы с именем "sheet1" "sheet2" "sheet3" ... и т. Д.

На листах 1,2,3 .. данные помещаются вcolums.Я хочу скопировать значения из ячеек B3, B183, B363, B603 и вставить данные в основной лист с именем «X», но в разные ячейки

Для каждого из данных одного листа я хочу вставить значенияв основной лист "x", после того, как этот шаг сделан, я хочу то же самое для листа 1, листа 2 ...

Но я не хочу перезаписывать первую скопированную ячейку и переходить в другую ячейку

Я сделал этот код:

 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

спасибо

Если у меня есть 3 листа, я хочу вставить данные каждого из них в одну строку / столбец, как

       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

Хорошо, этот код работает нормально:)

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

Телефонный код

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

Возможно, найдите первую пустую строку в столбце M и используйте ее вместо жесткого кодирования 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

---

Телефонный код

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