[英]Macro VBA to Copy Column based on Header and Paste into another Sheet
背景:这是我第一次处理宏。 我将使用两个工作表。 第一个工作表“来源”将提供可用数据。 第二个工作表“最终”将是空白的,并且将是宏将粘贴我希望它从“源”工作表收集的数据的位置。
* 我希望宏在“源”表中找到指定的标题,将包含标题的单元格一直复制到现有数据的最后一行(而不是整列),然后将其粘贴到“最终”指定列(A、B、C 等)中的工作表。 *
我必须指定要查找的标题的原因是因为“源”表中的标题不会始终位于相同位置,但“最终”表的标题将始终位于相同位置 - 所以我可以T 只记录宏复制“源”表中的 A 列并粘贴到“最终”表中的 A 列中。 此外,有一天“源”表可能有 170 行数据,而另一天可能有 180 行。
尽管如此,最好复制整列,因为其中一列将有几个空单元格,而不是复制到现有数据的最后一行。 我假设当它到达所选列中的第一个空单元格时它会停止复制,这会在列中的空单元格之后遗漏剩余的数据 - 如果我错了,请纠正我。 如果复制整个列是最好的方法,那么请将其作为可能的解决方案的一部分提供。 我附上了我想要完成的前后结果示例:结果示例
找到 Header=X,复制整列 -> 粘贴到“最终”表中的 A1
找到 Header=Y,复制整列 -> 粘贴到“最终”表中的 B1
等等..
如果我的措辞不准确,我很抱歉——我尽力解释。 如果有人能帮我解决这个问题,那就太棒了! 谢谢!
我修改了我给另一个有类似问题的用户的答案,我在我的大部分数据表中使用了字典函数,这样我就可以在不破坏代码的情况下移动列,下面的代码可以移动列,它会还在工作
唯一的主要限制是 1. 您的标题名称必须是唯一的 2. 您感兴趣的标题名称必须完全相同。 即您感兴趣的源头是 PETER,那么您的数据表应该有一个带有 PETER 的头并且它必须是唯一的。
Sub RetrieveData()
Dim wb As Workbook
Dim ws_A As Worksheet
Dim ws_B As Worksheet
Dim HeaderRow_A As Long
Dim HeaderLastColumn_A As Long
Dim TableColStart_A As Long
Dim NameList_A As Object
Dim SourceDataStart As Long
Dim SourceLastRow As Long
Dim Source As Variant
Dim i As Long
Dim ws_B_lastCol As Long
Dim NextEntryline As Long
Dim SourceCol_A As Long
Set wb = ActiveWorkbook
Set ws_A = wb.Worksheets("Sheet A")
Set ws_B = wb.Worksheets("Sheet B")
Set NameList_A = CreateObject("Scripting.Dictionary")
With ws_A
SourceDataStart = 2
HeaderRow_A = 1 'set the header row in sheet A
TableColStart_A = 1 'Set start col in sheet A
HeaderLastColumn_A = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column 'Get number of NAMEs you have
For i = TableColStart_A To HeaderLastColumn_A
If Not NameList_A.Exists(UCase(.Cells(HeaderRow_A, i).Value)) Then 'check if the name exists in the dictionary
NameList_A.Add UCase(.Cells(HeaderRow_A, i).Value), i 'if does not exist record name as KEY and Column number as value in dictionary
End If
Next i
End With
With ws_B 'worksheet you want to paste data into
ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column ' Get number of DATA you have in sheet B
For i = 1 To ws_B_lastCol 'for each data
SourceCol_A = NameList_A(UCase(.Cells(1, i).Value)) 'get the column where the name is in Sheet A from the dictionaary
If SourceCol_A <> 0 Then 'if 0 means the name doesnt exists
SourceLastRow = ws_A.Cells(Rows.Count, SourceCol_A).End(xlUp).Row
Set Source = ws_A.Range(ws_A.Cells(SourceDataStart, SourceCol_A), ws_A.Cells(SourceLastRow, SourceCol_A))
NextEntryline = .Cells(Rows.Count, i).End(xlUp).Row + 1 'get the next entry line of the particular name in sheet A
.Range(.Cells(NextEntryline, i), _
.Cells(NextEntryline, i)) _
.Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value
End If
Next i
End With
End Sub
你可以试试这个。 我认为它很清楚,而且是循序渐进的。 它可以非常优化,但从 vba 开始,我认为这样更好。
两个工作表中的列名称必须相同。
Sub teste()
Dim val
searchText = "TEXT TO SEARCH"
Sheets("sheet1").Select ' origin sheet
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
x = Selection.Columns.Count ' get number of columns
For i = 1 To x 'iterate trough origin columns
val = Cells(1, i).Value
If val = searchText Then
Cells(1, i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("sheet2").Select ' destination sheet
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
y = Selection.Columns.Count ' get number of columns
For j = 1 To y 'iterate trough destination columns
If Cells(1, j).Value = searchText Then
Cells(1, j).Select
ActiveSheet.Paste
Exit Sub
End If
Next j
End If
Next i
End Sub
祝你好运
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.