新しいワークシートへの選択列の自動コピー

Question

excelにはかなり新しく、ルーチンカットコピーの貼り付けを行う簡単な方法があるかどうか疑問に思っていました。私はワークシート1ワークシート2に生データをコピーするたびに、つまり、私はマクロが2をワークシートにワークシート1からいくつかの所定の列をコピーしたい

Name  Age Occupation Major WorkEx  Position..... 

：私は、次のような列の長いリストを持っているワークシートを持っています選択した列を自動入力する必要があります。この例では、前述の列をワークシート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