Question

对于excel来说相当新，并且想知道是否有更简单的方法来执行常规剪切复制粘贴。我有一个工作表，其列表很长，如下所示：

Name     Age    Occupation    Major    WorkEx     Position.....

我希望宏将工作表1中的一些预定列复制到工作表2，即每次将原始数据复制到工作表1时，工作表2应自动填充所选列。在这种情况下，例如，如果我将上述列粘贴到工作表1中，则名称，主要和位置应自动复制到工作表2中。

值得注意的是，原始数据并不总是如上所示。我认为关键是找到/找到标题，然后将整个列复制到特定列的工作表2上。

在这种情况下，工作表2将始终将Col 8-10和Col 16作为空白。

有人能帮我解决这个问题吗？如果有任何其他细节是必要的，请告诉我。

Answer 1

试试这个..只需将test1替换为您的列名等。
请记住添加列号而不是targetCol，因为您要对其进行硬编码。我使用范围对象来复制数据。

Option Explicit

Sub CopyCode()

'Declaring the variable lColumn as long to store the last Column number
Dim lColumn As Long
'Declaring the variable iCntr as long to use in the For loop
Dim iCntr As Long
Dim lastRow As Long
Dim lastCol As Long, targetCol As Long
Dim wks As Worksheet, targetWks As Worksheet
Dim rng As Range
Dim fCol As String

' Set wks so it is the activesheet
Set wks = ThisWorkbook.Sheets("Sheet1")

Set targetWks = ThisWorkbook.Sheets("Sheet2")

    lastCol = wks.Cells(1, wks.Columns.Count).End(xlToLeft).Column


'Assigning the last Column value to the variable lColumn
lColumn = lastCol

'Using for loop
For iCntr = lColumn To 1 Step -1

    If LCase(wks.Cells(1, iCntr)) Like LCase("Test1") Then
        ' Find column letter
        fCol = GetColumnLetter(iCntr)
        lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row

        ' Declare range object
        Set rng = wks.Range(fCol & "2:" & fCol & lastRow)

        ' Use Range object to copy data
        rng.Copy _
        Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
    End If

    If LCase(wks.Cells(1, iCntr)) Like LCase("Test2") Then
        ' Find column letter
        fCol = GetColumnLetter(iCntr)
        lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row

        ' Declare range object
        Set rng = wks.Range(fCol & "2:" & fCol & lastRow)

        ' Use Range object to copy data
        rng.Copy _
        Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
    End If

    If LCase(wks.Cells(1, iCntr)) Like LCase("Test") Then
        ' Find column letter
        fCol = GetColumnLetter(iCntr)
        lastRow = wks.Range(fCol & wks.Rows.Count).End(xlUp).Row

        ' Declare range object
        Set rng = wks.Range(fCol & "2:" & fCol & lastRow)

        ' Use Range object to copy data
        rng.Copy _
        Destination:=targetWks.Cells(1, targetCol) ' Replace targetCol with number of column (A=1, B=2, etc.)
    End If

    ' etc etc
Next

End Sub

Function GetColumnLetter(colNum As Long) As String
    Dim vArr
    vArr = Split(Cells(1, colNum).Address(True, False), "$")
    GetColumnLetter = vArr(0)
End Function

将选择列自动复制到新工作表

1 个答案: