在一张纸上列出一个列表，然后找到适当的选项卡并将内容复制到另一张纸上的下一个可用行

Question

我已经为此苦苦挣扎了一天左右，感到很困惑。

这是我想做的：

我有一张表，其中包含 A 列中选项卡名称的完整列表。称之为 Total Tabs。

我还有一张名为“Reps No Longer Here”的工作表。这是列表中各个选项卡的内容要复制到的目标工作表。

我可以将名称放入一个数组 (2D) 并访问各个成员，但我需要能够将数组中的列表名称与选项卡名称进行比较以找到正确的选项卡。找到后，将该选项卡的所有内容复制到“Reps No Longer Here”（下一个可用行）。

完成后，“Reps No Longer Here”表应该是数组中列出的所有选项卡的完整列表，并按代表名称排序。

我该怎么做呢？我在将选项卡与列表数组进行比较然后将所有非空行复制到“不再代表表”时遇到问题

感谢所有帮助...

杰夫

添加：

这是我目前所拥有的，但它不起作用：

Private Sub Combinedata()

Dim ws As Worksheet
Dim wsMain As Worksheet
Dim DataRng As Range
Dim Rw As Long
Dim Cnt As Integer
Dim ar As Variant
Dim Last As Integer

Cnt = 1

Set ws = Worksheets("Total Tabs")
Set wsMain = Worksheets("Reps No Longer Here")

wsMain.Cells.Clear

ar = ws.Range("A1", Range("A" & Rows.Count).End(xlUp))

Last = 1

For Each sh In ActiveWorkbook.Worksheets
        For Each ArrayElement In ar 'Check if worksheet name is found in array
            If ws.name <> wsMain.name Then
                If Cnt = 1 Then
                    Set DataRng = ws.Cells(2, 1).CurrentRegion
                    DataRng.Copy wsMain.Cells(Cnt, 1)
                Else: Rw = wsMain.Cells(Rows.Count, 1).End(xlUp).Row + 1
'don't copy header rows
                DataRng.Offset(1, 0).Resize(DataRng.Rows.Count - 1, _
                DataRng.Columns.Count).Copy ActiveSheet.Cells(Rw, 1)
                End If
            End If
        Cnt = Cnt + 1

Last = Last + 1


Next ArrayElement
Next sh


End Sub

更新 - 2014 年 7 月 3 日

这是修改后的代码。我将突出显示给出语法错误的行。

Sub CopyFrom2To1()

Dim Source As Range, Destination As Range
Dim i As Long, j As Long
Dim arArray As Variant

Set Source = Worksheets("Raw Data").Range("A1:N1")
Set Dest = Worksheets("Reps No Longer Here").Range("A1:N1")

arArray = Sheets("Total Tabs").Range("A1", Range("A" & Rows.Count).End(xlUp))

For i = 1 To 100


    For j = 1 To 100

        If Sheets(j).name = arArray(i, 1) Then        
                Source.Range("A" & j).Range("A" & j & ":N" & j).Copy ' A1:Z1 relative to A5 for e.g.
                ***Dest.Range("A" & i ":N" & i).Paste***
            Exit For
        End If
    Next j
Next i

End Sub

Answer 1

我昨天在这里发布了一个非常相似问题的解决方案。看看代码中的主循环：

Sub CopyFrom2TO1()
Dim Source as Range, Destination as Range
Dim i as long, j as long

Set Source = Worksheets("Sheet1").Range("A1")
Set Dest = Worksheets("Sheet2").Range("A2")

for i = 1 to 100

    for j = 1 to 100
        if Dest.Cells(j,1) = Source.Cells(i,1) then
                Source.Range("A" & j).Range("A1:Z1").Copy ' A1:Z1 relative to A5 for e.g.
                Dest.Range("A"&i).Paste
                Exit For
        end if
    next j
next i
End Sub

根据您的目的，这需要稍作修改，但它本质上是做同样的事情。将一列与另一列进行比较，并在匹配的地方复制。

Unable to find how to code: If Cell Value Equals Any of the Values in a Range