英文:
VBA copy and paste from one worksheet to another worksheet base on specific headers
问题
以下是您提供的VBA代码的中文翻译部分:
Sub pullData()
Dim header_count As Integer
Dim row_count As Integer
Dim col_count As Integer
Dim i As Integer
Dim j As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("模板") '请确保工作簿中的工作表名称与代码中的名称一致
Set ws2 = ThisWorkbook.Sheets("上个月") '请确保工作簿中的工作表名称与代码中的名称一致
ws2.Activate
header_count = WorksheetFunction.CountA(Range("A8", Range("A8").End(xlToRight)))
ws1.Activate
col_count = WorksheetFunction.CountA(Range("A8", Range("A8").End(xlToRight)))
row_count = WorksheetFunction.CountA(Range("A8", Range("A8").End(xlDown)))
For i = 1 To header_count
j = 1
Do While j <= col_count
If ws2.Cells(1, j) = ws1.Cells(1, j).Text Then
ws1.Range(Cells(1, j), Cells(row_count, j)).Copy
ws2.Cells(1, j).PasteSpecial xlPasteValues
Application.CutCopyMode = False
j = col_count
End If
j = j + 1
Loop
Next i
With ws2
.Activate
.Cells(1, i).Select
End With
End Sub
这是您提供的VBA代码的中文翻译部分,如有需要,请按照您的需求使用它。如果您有任何其他问题或需要进一步的帮助,请随时告诉我。
英文:
I just new to this VBA and have been trying myself by looking at YTube and I want to learn more. I want to copy and paste from one sheet to another sheet using their identical header name. The source worksheet has over 30 columns and lots of formula, text and date.
I want to transfer only 7 columns to the destination worksheet.The destination and source worksheets's header are on row 8.
I have the following code but using this code, it only copy and paste to column 1. I didn't get the rest, even though the header name is the same and i can't figure out what is wrong with this code.
I am expecting to copy and paste value using the matching headers and give me all data.
Any help please and thank you in advance.
Sub pullData()
Dim header_count As Integer
Dim row_count As Integer
Dim col_count As Integer
Dim i As Integer
Dim j As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Template")
Set ws2 = ThisWorkbook.Sheets("Prior Month")
ws2.Activate
header_count = WorksheetFunction.CountA(Range("A8", Range("A8").End(xlToRight)))
ws1.Activate
col_count = WorksheetFunction.CountA(Range("A8", Range("A8").End(xlToRight)))
row_count = WorksheetFunction.CountA(Range("A8", Range("A8").End(xlDown)))
For i = 1 To header_count
j = 1
Do While j <= col_count
If ws2.Cells(1, j) = ws1.Cells(1, j).Text Then
ws1.Range(Cells(1, j), Cells(row_count, j)).Copy
ws2.Cells(1, j).PasteSpecial xlPasteValues
Application.CutCopyMode = False
j = col_count
End If
j = j + 1
Loop
Next i
With ws2
.Activate
.Cells(1, i).Select
End With
End Sub
答案1
得分: 1
以下是您代码的翻译:
这是您代码的可运行版本:
Sub PullData()
Dim template As Worksheet
Dim priorMonth As Worksheet
Dim priorMonthHeaderCount As Long
Dim templateColCount As Long
Set template = ThisWorkbook.Sheets("模板")
Set priorMonth = ThisWorkbook.Sheets("上个月")
priorMonthHeaderCount = priorMonth.Cells(1, Columns.Count).End(xlToLeft).Column
templateColCount = template.Cells(1, Columns.Count).End(xlToLeft).Column
Dim priorMonthHeaderIndex As Long
Dim templateColumnIndex As Long
For priorMonthHeaderIndex = 1 To priorMonthHeaderCount
For templateColumnIndex = 1 To templateColCount
If priorMonth.Cells(1, priorMonthHeaderIndex) = template.Cells(1, templateColumnIndex) Then
template.Columns(templateColumnIndex).Copy Destination:=priorMonth.Columns(priorMonthHeaderIndex)
Exit For
End If
Next templateColumnIndex
Next priorMonthHeaderIndex
End Sub
这不如您期望的工作,因为您写成了If ws2.Cells(1, j) = ws1.Cells(1, j).Text
而不是If ws2.Cells(1, i) = ws1.Cells(1, j).Text
。
可能需要一分钟来看出两者之间的区别。这就是为什么给您的变量取有意义的名称可以如此有帮助的原因。
一些更改:
- 为了提高可读性,将
Do ... While
更改为嵌套的For
循环。 - 删除了
Activate
和Select
,因为它们在此代码中不需要。 - 给变量取了更具描述性的名称。
- 将
j = col_count
更改为Exit For
以提高可读性。 - 根据ozgrid.com的建议,在
.Copy
方法中使用Destination:=
参数会绕过剪贴板。因此,您无需清除剪贴板,我已经删除了Application.CutCopyMode = False
。
英文:
Here is a working version of your code:
Sub PullData()
Dim template As Worksheet
Dim priorMonth As Worksheet
Dim priorMonthHeaderCount As Long
Dim templateColCount As Long
Set template = ThisWorkbook.Sheets("Template")
Set priorMonth = ThisWorkbook.Sheets("Prior Month")
priorMonthHeaderCount = priorMonth.Cells(1, Columns.Count).End(xlToLeft).Column
templateColCount = template.Cells(1, Columns.Count).End(xlToLeft).Column
Dim priorMonthHeaderIndex As Long
Dim templateColumnIndex As Long
For priorMonthHeaderIndex = 1 To priorMonthHeaderCount
For templateColumnIndex = 1 To templateColCount
If priorMonth.Cells(1, priorMonthHeaderIndex) = template.Cells(1, templateColumnIndex) Then
template.Columns(templateColumnIndex).Copy Destination:=priorMonth.Columns(priorMonthHeaderIndex)
Exit For
End If
Next templateColumnIndex
Next priorMonthHeaderIndex
End Sub
This was not working for you as expected because you wrote
<br>
If ws2.Cells(1, j) = ws1.Cells(1, j).Text
instead of
<br>
If ws2.Cells(1, i) = ws1.Cells(1, j).Text
It may take you a minute to see the difference between the two. This is why giving meaningful names to your variables can be so helpful.
Some changes:
- Changed the
Do ... While
to a nestedFor
loop for better readability - Removed the
Activate
andSelect
, since they are not needed for this code - Gave more descriptive variable names
- Changed
j = col_count
toExit For
for better readability - According to ozgrid.com, using the
Destination:=
argument in the.Copy
method bypasses the Clipboard. Therefore you don't need to clear it and I was able to removeApplication.CutCopyMode = False
.
答案2
得分: 0
根据标题复制数据
Sub PullData()
' 定义常量
Const SRC_SHEET As String = "模板"
Const SRC_HEADER_ROW As Long = 8
Const DST_SHEET As String = "上个月"
Const DST_HEADER_ROW As Long = 8
Dim wb As Workbook: Set wb = ThisWorkbook ' 包含此代码的工作簿
' 引用源范围。
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim shrg As Range, sdrg As Range, srCount As Long
With sws.UsedRange
Set shrg = Intersect(sws.Rows(SRC_HEADER_ROW), .Cells)
srCount = .Rows(.Rows.Count).Row - SRC_HEADER_ROW
Set sdrg = shrg.Resize(srCount).Offset(1)
End With
' 引用目标范围。
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
Dim dhrg As Range, ddrg As Range
With dws.UsedRange
Set dhrg = Intersect(dws.Rows(DST_HEADER_ROW), .Cells)
Set ddrg = dhrg.Offset(1).Resize(srCount)
End With
' 拉取数据。
Dim scIndexes: scIndexes = Application.Match(dhrg, shrg, 0)
Dim scIndex, dc As Long
For Each scIndex In scIndexes
dc = dc + 1
If IsNumeric(scIndex) Then
ddrg.Columns(dc).Value = sdrg.Columns(scIndex).Value
End If
Next scIndex
' 提示信息。
MsgBox "数据已拉取。", vbInformation
End Sub
英文:
Copy Data Based on Headers
<!-- language: lang-vb -->
Sub PullData()
' Define constants
Const SRC_SHEET As String = "Template"
Const SRC_HEADER_ROW As Long = 8
Const DST_SHEET As String = "Prior Month"
Const DST_HEADER_ROW As Long = 8
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the source ranges.
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim shrg As Range, sdrg As Range, srCount As Long
With sws.UsedRange
Set shrg = Intersect(sws.Rows(SRC_HEADER_ROW), .Cells)
srCount = .Rows(.Rows.Count).Row - SRC_HEADER_ROW
Set sdrg = shrg.Resize(srCount).Offset(1)
End With
' Reference the destination ranges.
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
Dim dhrg As Range, ddrg As Range
With dws.UsedRange
Set dhrg = Intersect(dws.Rows(DST_HEADER_ROW), .Cells)
Set ddrg = dhrg.Offset(1).Resize(srCount)
End With
' Pull.
Dim scIndexes: scIndexes = Application.Match(dhrg, shrg, 0)
Dim scIndex, dc As Long
For Each scIndex In scIndexes
dc = dc + 1
If IsNumeric(scIndex) Then
ddrg.Columns(dc).Value = sdrg.Columns(scIndex).Value
End If
Next scIndex
' Inform.
MsgBox "Data pulled.", vbInformation
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论