具有相同名稱的拉列和複製到不同的工作表

Question

我想多列使用相同的標題名稱複製到一個新的工作表。

我遇到的問題是它只複製一列而留下其他空白。

在這個例子中，我想要的日期是在第1列和5列，但它只有5

Sub MoveColumns() 
' MoveColumns Macro 

' Description: Rearrange columns in Excel based on column header 
Dim iRow As Long 
Dim iCol As Long 
'Constant values 
data_sheet1 = InputBox("Specify the name of the Sheet that needs to be reorganized:") 'Create Input Box to ask the user which sheet needs to be reorganised 
target_sheet = "Final Report" 'Specify the sheet to store the results 
iRow = Sheets(data_sheet1).UsedRange.Rows.Count 'Determine how many rows are in use 
'Create a new sheet to store the results 
Worksheets.Add.Name = "Final Report" 
'Start organizing columns 
For iCol = 1 To Sheets(data_sheet1).UsedRange.Columns.Count 
'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns 
TargetCol = 0 
'Read the header of the original sheet to determine the column order 

If Sheets(data_sheet1).Cells(1, iCol).value = "DATE" Then TargetCol = 1 
If Sheets(data_sheet1).Cells(1, iCol).value = "SYSTEM NAME" Then TargetCol = 2 
If Sheets(data_sheet1).Cells(1, iCol).value = "CH" Then TargetCol = 3 
If Sheets(data_sheet1).Cells(1, iCol).value = "CARR KEY" Then TargetCol = 3 
If Sheets(data_sheet1).Cells(1, iCol).value = "FLAG" Then TargetCol = 4 
If Sheets(data_sheet1).Cells(1, iCol).value = "DATE" Then TargetCol = 5 



'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot 
If TargetCol <> 0 Then 
'Select the column and copy it 
Sheets(data_sheet1).Range(Sheets(data_sheet1).Cells(1, iCol), Sheets(data_sheet1).Cells(iRow, iCol)).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol) 
End If 
Next iCol 'Move to the next column until all columns are read 


End Sub 

Answer 1

更改你的第二次約會列標題放置列目標列到別的東西像日期2這我在下面的代碼中使用過。否則，您的第一個條件將始終評估爲True，並且會始終選取第一列。

您可以嘗試像thie ...

Sub MoveColumns() 
' MoveColumns Macro 

' Description: Rearrange columns in Excel based on column header 
Dim iRow As Long 
Dim iCol As Long 
Dim TargetCol As Long 
Dim FirstDate As Boolean 
'Constant values 
data_sheet1 = InputBox("Specify the name of the Sheet that needs to be reorganized:") 'Create Input Box to ask the user which sheet needs to be reorganised 
target_sheet = "Final Report" 'Specify the sheet to store the results 
iRow = Sheets(data_sheet1).UsedRange.Rows.Count 'Determine how many rows are in use 
'Create a new sheet to store the results 
Worksheets.Add.Name = "Final Report" 
'Start organizing columns 
For iCol = 1 To Sheets(data_sheet1).UsedRange.Columns.Count 
'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns 
TargetCol = 0 
'Read the header of the original sheet to determine the column order 

If LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "date" Then 
    If Not FirstDate Then 
     TargetCol = 1 
     FirstDate = True 
    Else 
     TargetCol = 6 
    End If 
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "system name" Then 
    TargetCol = 2 
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "ch" Then 
    TargetCol = 3 
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "carr key" Then 
    TargetCol = 4 
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "flag" Then 
    TargetCol = 5 
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "date" Then 
    TargetCol = 6 
End If 



'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot 
If TargetCol <> 0 Then 
'Select the column and copy it 
Sheets(data_sheet1).Range(Sheets(data_sheet1).Cells(1, iCol), Sheets(data_sheet1).Cells(iRow, iCol)).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol) 
End If 
Next iCol 'Move to the next column until all columns are read 
End Sub