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

将您的第二个日期列标题更改为我在下面的代码中使用的Date2之类的其他内容。否则，您的第一个条件将始终被评估为True，它将始终选择第一列。

你可以尝试一下......

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

拉取具有相同名称的列并将其复制到不同的工作表中

1 个答案: