通过多个工作表设置范围

我有5个相同的工作表（命名为：10,20,30,40,50），并希望将它们复制到一个单独的文件（名称：csv）中。 首先，我定义了范围（对于所有5都是相同的），如果单元格的值为<>“”和0，则macros应在所有工作表中进行search。

另外，如果条件满足，我想复制更多的值。 不幸的是我没有得到我想要的价值。

有谁能发现我的错误？

感兴趣的是：当只有一个工作表作为源时，代码工作得很好，所以我想我必须改变/调整范围。 不幸的是我的VBA仍然很差，我找不到解决scheme

Sub Sample() Dim i As Integer Dim j As Integer Dim resultrange As Range Dim row As Range Dim sheetsArray As Sheets Set sheetsArray = ActiveWorkbook.Sheets(Array("10", "20", "30", "40", "50")) Dim target As Range Dim sheetObject As Worksheet For Each sheetObject In sheetsArray Set target = sheetObject.Range("H6:T529") Next sheetObject Dim cell As Range Set resultrange = Sheets("CSV").Range("C2:T1000") i = 1 For Each cell In target If (cell.value <> "" And cell.value <> 0) Then resultrange.Rows.Cells(i, 5).value = cell.value resultrange.Rows.Cells(i, 17).value = Range("A" & cell.row).value resultrange.Rows.Cells(i, 18).value = Range(Col_Letter(cell.column) & "2").value resultrange.Rows.Cells(i, 2).value = Range(Col_Letter(cell.column) & "1").value i = i + 1 End If Next cell End Sub 

'我从其他论坛复制的function以合理的方式显示列

 Function Col_Letter(lngCol As Long) As String Dim vArr vArr = Split(Cells(1, lngCol).Address(True, False), "$") Col_Letter = vArr(0) End Function 

Answer 1

你需要嵌套你的循环。 这个代码…

 For Each sheetObject In sheetsArray Set target = sheetObject.Range("H6:T529") Next sheetObject 

…对target范围没有任何作用，所以当这个循环退出时，你只会复制最后设置的Range 。

 Dim cell As Range Set ResultRange = Sheets("CSV").Range("C2:T1000") i = 1 For Each sheetObject In sheetsArray Set target = sheetObject.Range("H6:T529") For Each cell In target With target.Worksheet If (cell.Value <> "" And cell.Value <> 0) Then ResultRange.Rows.Cells(i, 5).Value = cell.Value ResultRange.Rows.Cells(i, 17).Value = .Cells(cell.Row, 1).Value ResultRange.Rows.Cells(i, 18).Value = .Cells(2, cell.Column).Value ResultRange.Rows.Cells(i, 2).Value = .Cells(1, cell.Column).Value i = i + 1 End If End With Next cell Next sheetObject