在不同的单元格上粘贴不同的值答案

【问题标题】：Paste different values on different cells在不同的单元格上粘贴不同的值
【发布时间】：2019-07-23 11:18:51
【问题描述】：

我有一个名为“x”的主工作表和其他名为“sheet1”“sheet2”“sheet3”的工作表......等等

在工作表 1、2、3.. 上，数据以列的形式放置。我想从单元格 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)

【问题讨论】：

标签： excel vba

【解决方案1】：

也许在 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

【讨论】：

您好，感谢您的回答，但我收到此错误：此代码的下标超出范围 :)
修复了超出范围的错误，但现在不起作用，没有数据被复制，也没有数据被粘贴
我所做的一切都不应该影响到这一点。您是否尝试过使用 F8 单步执行代码以查看发生了什么？
为我工作，使用我在上面发布的调用代码。你在粘贴公式吗？
是的，我已经复制了代码，但是当我按下按钮时没有任何反应，代码没有错误，但它什么也没做

【解决方案2】：

好的，这段代码运行良好:)

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

【讨论】：