拉同名的列并复制到不同的工作表中

我试图复制具有相同标题名称的多个列到一个新的工作表。

我遇到的问题是它只复制一列，并留下其他空白。

在这个例子中，我希望date在第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

将第二个date列标题更改为我在下面的代码中使用的Date2。 否则，您的第一个条件将始终评估为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