Copy data from one excel sheet to another (complex) using VBA based on column name

前端 未结 3 459
北恋
北恋 2021-01-07 11:24

I\'m very new to VBA and after 5 hours of watching videos and Googling, I think this is just too over my head... any help is very much appreciated.

So I have 2 excel

3条回答
  •  猫巷女王i
    2021-01-07 12:11

    Alright, now it works also if you have columns in Sheet2 that do not exist in Sheet1.

    Sub CopySheet() Dim i As Integer Dim LastRow As Integer Dim Search As String Dim Column As Integer

    Sheets("Sheet1").Activate
    Sheets("Sheet1").Range("A1").Select
    'Sets an Autofilter to sort out only your Yes rows.
    Selection.Autofilter
    'Change Field:=5 to the number of the column with your Y/N.
    Sheets("Sheet1").Range("$A$1:$G$3").Autofilter Field:=7, Criteria1:="Y"
    
    'Finds the last row
    LastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    
    i = 1
    'Change the 3 to the number of columns you got in Sheet2
    Do While i <= 3
        Search = Sheets("Sheet2").Cells(1, i).Value
        Sheets("Sheet1").Activate
        'Update the Range to cover all your Columns in Sheet1.
        If IsError(Application.Match(Search, Sheets("sheet1").Range("A1:G1"), 0)) Then
            'nothing
        Else
            Column = Application.Match(Search, Sheets("sheet1").Range("A1:G1"), 0)
            Sheets("Sheet1").Cells(2, Column).Resize(LastRow, 1).Select
            Selection.Copy
            Sheets("Sheet2").Activate
            Sheets("Sheet2").Cells(2, i).Select
            ActiveSheet.Paste
        End If
        i = i + 1
    Loop
    
    'Clear all Y/N = Y
    'Update the Range to cover all your Columns in Sheet1.
    Sheets("Sheet1").Activate
    Column = Application.Match("Y/N", Sheets("sheet1").Range("A1:G1"), 0)
    Sheets("Sheet1").Cells(2, Column).Resize(LastRow, 1).Select
    Selection.ClearContents
    End Sub
    

提交回复
热议问题