查找具有特定标题的数据，并将整列复制到另一张纸上

Yvian 发表于 Dev

依云

我想创建一个VBA，通过“摘要”工作表中的特定列排列将数据复制到“摘要”中，然后粘贴到“摘要”工作表中。

例如，如果工作表“摘要”列A为COUNTER CODE，则从工作表“ RAW”中复制数据位于B2-B5中，然后将其粘贴到我的工作表“摘要” A2-A5中

我试图使用下面的VBA，它可以工作。但是，如果“ RAW”中的列数据不同，我将无法获得正确的数据。

Sub TRANSFERDATA()

Dim LASTROW As Long, EROW As Long
LASTROW = Worksheets("RAW").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LASTROW

Worksheets("RAW").Cells(i, 1).Copy

EROW = Worksheets("summary").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("RAW").Paste Destination:=Worksheets("summary").Cells(EROW + 1, 2)

Worksheets("RAW").Cells(i, 2).Copy

Worksheets("RAW").Paste Destination:=Worksheets("summary").Cells(EROW + 1, 1)

Worksheets("RAW").Cells(i, 3).Copy

Worksheets("RAW").Paste Destination:=Worksheets("summary").Cells(EROW + 1, 4)

Worksheets("RAW").Cells(i, 4).Copy

Worksheets("RAW").Paste Destination:=Worksheets("summary").Cells(EROW + 1, 3)
Next i

End Sub

谢谢！

概要

生的

范杜鲁

请测试下一个代码。您不必逐个复制单元格。在设计代码的方式中，它也适用于与“ RAW”工作表中的标题不相同的标头，但包含“ RAW”标头字符串：

Sub TestFindCopyInPlace()
   Dim shR As Worksheet, shSum As Worksheet, colHeadR As String
   Dim colHS As Range, lastCol As Long, lastRow As Long, i As Long

   Set shR = Worksheets("RAW")
   Set shSum = Worksheets("summary")
   lastCol = shR.Cells(1, Columns.count).End(xlToLeft).Column
   lastRow = shR.Range("A" & Rows.count).End(xlUp).Row
   For i = 1 To lastCol
        colHeadR = shR.Columns(i).Cells(1, 1).value
        Set colHS = shSum.Rows(1).Find(colHeadR)' find the cell with the header of the one being copied
        If Not colHS Is Nothing Then 'Find method will find a column containing colHeadR in its header string...
             shR.Range(shR.Cells(2, i), shR.Cells(lastRow, i)).Copy Destination:=colHS.Offset(1, 0)
        Else
             MsgBox "The column header """ & colHeadR & """ could not be found." & vbCrLf & _
               "Please check the spelling or whatever you think it is necessary..."
        End If
   Next i
End Sub

该代码应适用于您的“ RAW”工作表包含的尽可能多的列...

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。