將選擇列自動複製到新工作表

Question

對於excel來說相當新穎，並且想知道是否有更簡單的方法來執行常規剪切複製粘貼操作。我有一個具有列一個長長的清單，它看起來像下面的工作表：

Name  Age Occupation Major WorkEx  Position..... 

我要宏觀一些預定列從工作表中複製到工作表，每次我的原始數據複製到工作表1表2 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