Question

我正在尝试创建一个宏，以在标题和列A数据匹配并且想要粘贴到特定单元格中时，将数据从一个工作表复制并粘贴到另一工作表。

当两个工作表中的行（标题）顺序相同时，以下代码对我来说工作正常。但是当行（标题）的顺序不正确时，我需要一个解决方案。

“我希望我能够解释我的问题”

Sub transfer()
    Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
    Dim myname As String
    lastrow1 = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To lastrow1
        myname = Sheets("sheet1").Cells(i, "A").Value
        Sheets("sheet2").Activate
        lastrow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

        For j = 2 To lastrow2       
            If Sheets("sheet2").Cells(j, "A").Value = myname Then
                Sheets("sheet1").Activate
                Sheets("sheet1").Range(Cells(i, "B"), Cells(i, "F")).Copy
                Sheets("sheet2").Activate
                Sheets("sheet2").Range(Cells(j, "D"), Cells(j, "H")).Select
                ActiveSheet.Paste
            End If
        Next j
        Application.CutCopyMode = False
    Next i

    Sheets("sheet1").Activate
    Sheets("sheet1").Range("A1").Select 
End Sub

Answer 1

如果我了解您的目标，则可以尝试类似的操作（使用临时数据测试代码）

Sub test()
Dim SrcWs As Worksheet, TrgWs As Worksheet
Dim Col As Long, TrgLastRw As Long, SrclastRw As Long, SrcLastCol As Long, TrgLastCol As Long
Dim SrcRng As Range, TrgRng As Range, C As Range, Hd As String
Set SrcWs = ThisWorkbook.Sheets("Sheet1")
Set TrgWs = ThisWorkbook.Sheets("Sheet2")
SrcLastCol = SrcWs.Cells(1, Columns.Count).End(xlToLeft).Column
TrgLastCol = TrgWs.Cells(1, Columns.Count).End(xlToLeft).Column

    For Col = 1 To SrcLastCol                   
    Hd = SrcWs.Cells(1, Col).Value
        If Hd <> "" Then
        SrclastRw = SrcWs.Cells(Rows.Count, Col).End(xlUp).Row + 1
        Set SrcRng = SrcWs.Range(SrcWs.Cells(2, Col), SrcWs.Cells(SrclastRw, Col))
            With TrgWs.Range(TrgWs.Cells(1, 1), TrgWs.Cells(1, TrgLastCol))
            Set C = .Find(Hd, LookIn:=xlValues)    'each column header is searched in trgWs
                If Not C Is Nothing Then
                TrgLastRw = TrgWs.Cells(Rows.Count, C.Column).End(xlUp).Row + 1
                Set TrgRng = TrgWs.Cells(TrgLastRw, C.Column).Resize(SrcRng.Rows.Count, 1)
                SrcRng.Copy Destination:=TrgRng
                End If
            End With
        End If
    Next Col
End Sub

标题匹配时将数据从一个工作表复制并粘贴到另一个工作表的宏

1 个答案: