VBA 代码将数据从多个工作表复制到另一个工作表所需的指导

Question

您好，我在下面编写了代码，用于将特定范围的单元格从一个工作表复制到另一个名为 “报告”。

Sub sample()

Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String

With Sheets("Jack")
lastRow = .Range("A" & Rows.Count).End(xlUp).Row

If lastRow < 4 Then lastRow = 4

For i = 5 To lastRow
For col = 2 To 31
If .Cells(i, col) <> "" Then

a = .Cells(1, 2)
b = .Cells(i, 1)
c = .Cells(i, col)
d = .Cells(3, col)

With Sheets("Report")
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).Value = a
.Range("B" & .Range("B" & .Rows.Count).End(xlUp).Row + 1).Value = b
.Range("C" & .Range("C" & .Rows.Count).End(xlUp).Row + 1).Value = c
.Range("D" & .Range("D" & .Rows.Count).End(xlUp).Row + 1).Value = d
End With
End If
Next
Next

End With
End Sub

上面的代码非常适合从名为“Jack”的单个工作表中复制数据，但我也在尝试从其他工作表中获取数据。共有 10 个工作表，我想将数据从 sheet2 复制到 sheet7，并希望跳过 sheet1、sheet 8、9 和 10。 任何帮助创建循环以从选定的工作表中复制数据将不胜感激。 谢谢

Answer 1

如果所有数据都相同，那么它应该像替换你的一样简单

With Sheets("Jack")

与

For x = 2 To 7

With Sheets(x)

并在最后添加一个 Next。

所以完整的代码如下所示：

Sub sample()


Dim lastRow As Long
Dim col As Long
Dim a As String, b As String, c As String

For x = 2 To 7

With Sheets(x)

lastRow = .Range("A" & Rows.Count).End(xlUp).Row

If lastRow < 4 Then lastRow = 4

For i = 5 To lastRow
For col = 2 To 31
If .Cells(i, col) <> "" Then

a = .Cells(1, 2)
b = .Cells(i, 1)
c = .Cells(i, col)
d = .Cells(3, col)

With Sheets("Report")
.Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).Value = a
.Range("B" & .Range("B" & .Rows.Count).End(xlUp).Row + 1).Value = b
.Range("C" & .Range("C" & .Rows.Count).End(xlUp).Row + 1).Value = c
.Range("D" & .Range("D" & .Rows.Count).End(xlUp).Row + 1).Value = d
End With
End If
Next
Next

End With
Next x

End Sub