Question

我一直在和它搏斗一天左右而且很难过。

这是我想要做的：

我有一张表格，其中包含A栏中标签名称的完整列表。请调用此总标签。

我有另一张名为＆＃34; Reps No Longer Here＆＃34;。这是目标表，其中列表中各个选项卡的内容将被复制到。

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

当它完成时，表单＆＃34;不再在这里代表＆＃34;应该是数组中列出的所有选项卡的完整列表，并按代码名称排序。

我怎么做到这一点？我真的遇到了将标签与列表数组进行比较，然后将所有非空行复制到＆＃34; Reps No Longer Sheet＆＃34;

的问题。

我感谢所有的帮助...

杰夫

增加：

这是我到目前为止所做的，但它还没有工作：

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

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

1 个答案: