如何使用 VBA 宏从一个工作表复制“特定”行并粘贴到另一个工作表中

Question

我有两张纸（第一张和第二张）。 Sheet1 是 sheet2 的子集。我编写了一个宏来比较两张表的标题，然后如果匹配，则将表 1 中的所有内容复制到表 2。 下一个要求是，我在 Sheet1 中有一个键列，我现在需要根据键列值将表 1 的内容粘贴到表 2、表 3、表 4。 请在附件中找到详细的屏幕截图，也请在 Stack-overflow 中找到我在你们的帮助下编写的代码。 我是新手，需要你的帮助。 Image.Please Click

代码：

Private Sub CommandButton3_Click()

Application.ScreenUpdating = False

Dim lastrow As Long, header As Range, foundHeader As Range, lCol As Long, srcWS , desWS1 As Worksheet
Set srcWS = Sheets("Sheet1")
Set desWS1 = Sheets("Sheet2")

lastrow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

lCol = desWS1.Cells(1, Columns.count).End(xlToLeft).Column
For Each header In desWS1.Range(desWS1.Cells(1, 1), desWS1.Cells(1, lCol))
    Set foundHeader = srcWS.Rows(2).Find(header, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundHeader Is Nothing Then
        srcWS.Range(srcWS.Cells(2, foundHeader.Column), srcWS.Cells(lastrow, foundHeader.Column)).Copy desWS1.Cells(1, header.Column)
    End If
Next header

lCol = desWS2.Cells(1, Columns.count).End(xlToLeft).Column
**' I am stuck here. Unable to think beyond these two lines after applying the filter**
**Sheets("Sheet1").Cells(1, 1).AutoFilter Field:=7, Criteria1:="Yellow"
Sheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).Select**

    For Each header In desWS2.Range(desWS2.Cells(1, 1), desWS2.Cells(1, lCol))
        Set foundHeader = srcWS.Rows(2).Find(header, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundHeader Is Nothing Then
            srcWS.Range(srcWS.Cells(2, foundHeader.Column), srcWS.Cells(lastrow, foundHeader.Column)).Copy desWS2.Cells(1, header.Column)
        End If
    Next header

Application.ScreenUpdating = True

End Sub

非常感谢您的时间和帮助。

Answer 1

不是我的工作所以甚至不会假装，但你试过这个吗？

信用：https://www.excelcampus.com/vba/copy-paste-cells-vba-macros/

    Sub Range_Copy_Examples()
'Use the Range.Copy method for a simple copy/paste

    'The Range.Copy Method - Copy & Paste with 1 line
    Range("A1").Copy Range("C1")
    Range("A1:A3").Copy Range("D1:D3")
    Range("A1:A3").Copy Range("D1")
    
    'Range.Copy to other worksheets
    Worksheets("Sheet1").Range("A1").Copy Worksheets("Sheet2").Range("A1")
    
    'Range.Copy to other workbooks
    Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Copy _
        Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1")

End Sub


Sub Paste_Values_Examples()
'Set the cells' values equal to another to paste values

    'Set a cell's value equal to another cell's value
    Range("C1").Value = Range("A1").Value
    Range("D1:D3").Value = Range("A1:A3").Value
     
    'Set values between worksheets
    Worksheets("Sheet2").Range("A1").Value = Worksheets("Sheet1").Range("A1").Value
     
    'Set values between workbooks
    Workbooks("Book2.xlsx").Worksheets("Sheet1").Range("A1").Value = _
        Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value
        
End Sub

基本上你试图做一个 vlookup 听起来像。这个网站过去也帮助过我。

https://powerspreadsheets.com/excel-vba-vlookup/

VLookupResult = WorksheetFunction.vlookup(LookupValue, Worksheet.TableArray, ColumnIndex, False)