我想将值从工作表 A 复制到工作表 B 但让它循环遍历两个工作表中的标题，在工作表 B 中找到标题并根据标题将值从工作表 A 粘贴到 B 中。这背后的原因是标题不在同一个列名中，因此直接复制和粘贴将不起作用。
我有一块可以正常复制和粘贴它。但是如何让它循环遍历 Sheet B 中的现有标题，标题将在第 1 行中预定义。卡在复制和粘贴部分。
Sub stack()
Dim i As Integer
Dim y As Integer
Dim src As Range
Dim tgt As Range
Dim Headloop As String
Dim Headloop2 As String
Set src = Sheets("sheet1") 'source sheet
Set tgt = Sheets("sheet2") 'destination sheet
With tgt
For i = 1 To max_col
Headloop = Range(i & "1").value 'i is column Number, "1" is row 1
Next i
End With
With src
For y = 1 To max_col
Headloop2 = Range(y & "1").value 'y is column Number, "1" is row 1
Next y
End With
For Each i In tgt
If Headloop > 0 Then
Range(y&"2"),src.Copy Destination: = tgt.range(i&"2").value
End If
Next i
End Sub
谢谢。
这是一个基本原理示例。
我假设源标题位于第 1 页的第 1 行，因此请使用：
Intersect(.Rows(1), .UsedRange).SpecialCells(xlCellTypeConstants)
找到该行中的所有标题并循环遍历它们。
每个源头都是当前的rng.Value.
我用来Find将它与 sheet2 的第 1 行相匹配。
trgt.Rows(1).Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
如果找到，则复制标题下的数据：
If Not trgtCell Is Nothing Then
.Range(rng.Offset(1), .Cells(.Rows.Count, rng.Column).End(xlUp)).Copy
我使用匹配的单元格 ,trgtCell来确定要粘贴到的列。
我粘贴到该列中的下一个可用行使用
.Cells(.Rows.Count, trgtCell.Column).End(xlUp).Row + 1
代码：
Option Explicit
Sub CopyByHeaders()
Dim rng As Range, trgtCell As Range, src As Worksheet, trgt As Worksheet
Set src = Worksheets("Sheet1")
Set trgt = Worksheets("Sheet2")
Application.ScreenUpdating = False
With src
For Each rng In Intersect(.Rows(1), .UsedRange).SpecialCells(xlCellTypeConstants)
Set trgtCell = trgt.Rows(1).Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not trgtCell Is Nothing Then
.Range(rng.Offset(1), .Cells(.Rows.Count, rng.Column).End(xlUp)).Copy
With trgt
.Range(Split(trgtCell.Address, "$")(1) & .Cells(.Rows.Count, trgtCell.Column).End(xlUp).Row + 1).PasteSpecial
End With
End If
Next rng
End With
Application.ScreenUpdating = True
End Sub
要粘贴到目标的第 2 行，请使用：
.Range(Split(trgtCell.Address, "$")(1) & 2).PasteSpecial
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句