excel - VBA code to copy column from Excel based on header name to another sheet
问题描述
I am trying to create an Excel Macro using VBA to copy entire columns based on the column heading to an Excel sheet. So far, my code works when the column heading is located in the first row of the sheet, but if I alter HeaderRow_A = 5
and SourceDataStart = 6
for a sheet where the column headings are on the fifth row instead of the first, the first column copies over as expected, but the other columns do not. I need some code revisions that will allow all the desired columns to be copied over from Sheet A to Sheet B. Here is the specific area where I am encountering the issue:
With ws_A
SourceDataStart = 6
HeaderRow_A = 5 '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
Here is the entire code for your reference:
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 = 6
HeaderRow_A = 5 '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
解决方案
我看到表 B 上标题所在位置的两个相互冲突的定义。
此代码段表示您的工作表 B 标题与工作表 A 位于同一行
ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column
这个片段说他们在第 1 行
SourceCol_A = NameList_A(UCase(.Cells(1, i).Value))
我想这就是问题所在。
推荐阅读
- php - 如何将 updateOrCreate 与 hasMany 关系一起使用?
- flutter - Flutter ClipPath 阴影
- javascript - 在按钮单击和抓取 Web 数据时发送获取命令
- unity3d - 即使一切正确,在画布中统一创建的暂停菜单中的按钮也不起作用
- express - 如何将 eventEmitter 添加到我的 Express 应用程序?
- javascript - javascript对象迭代的问题:仅打印2行
- javascript - 如何使用事件 Onclick 删除推入数组的对象?
- c# - 尝试一起减去 2 个值会导致它们相加,除加法之外的所有运算符也不起作用
- java - 如何将bean注入配置覆盖方法
- node.js - 如何为 NodeJS 无服务器项目中的所有 lambdas 初始化 AWS XRay