Loop is copying the columns in the wrong ranges-CodePudding

I have made this code to create an output sheet where columns from different sheets are sorted by header name and pasted one after the other.

For some reason, it is not pasting the columns underneath each other, but instead overwriting each one with the next:

Dim ws As worksheet
Dim max_ws As worksheet
Dim output_ws As worksheet
Dim max_ws_header As Range
Dim output_ws_header As Range
Dim header_cell As Range
Dim cc As Long
Dim max_cc As Long
Dim output_header_counter As Long
Dim ws_header_counter As Long
Dim output_header_name As String
Dim ws_header_name As String


Application.DisplayAlerts = False
Sheets("indice").Delete
Sheets("aneca").Delete
Application.DisplayAlerts = True

For Each ws In Worksheets
    ws.Rows(1).EntireRow.Delete
    ws.Columns.Hidden = False
Next ws

max_cc = 0

For Each ws In Worksheets
    cc = last_column_index(ws, 1)
    If cc > max_cc Then
        max_cc = cc
        Set max_ws = ws
    End If
Next ws

Sheets.Add.Name = "Output"
Set output_ws = Sheets("Output")

Set max_ws_header = max_ws.Range(max_ws.Cells(1, 1), max_ws.Cells(1, max_cc))
Set output_ws_header = output_ws.Range(output_ws.Cells(1, 1), output_ws.Cells(1, max_cc))

max_ws_header.Copy output_ws_header

For Each ws In Worksheets
    If ws.Name <> "Output" Then
        For output_header_counter = 1 To max_cc
            output_header_name = output_ws.Cells(1, output_header_counter).Value
            For ws_header_counter = 1 To max_cc
                ws_header_name = ws.Cells(1, ws_header_counter).Value
                If ws_header_name = output_header_name Then
                ws.Range(Cells(1, ws_header_counter), Cells(last_row_index(ws, ws_header_counter), ws_header_counter)).Copy _
                output_ws.Range(Cells(last_row_index(output_ws, output_header_counter)   1, output_header_counter), Cells(last_row_index(ws, ws_header_counter), output_header_counter))
                End If
            Next ws_header_counter
        Next output_header_counter
    End If

The functions last_row_index and last_column_index are UDFs that I made as follows:

Function last_row_index(target_worksheet As worksheet, target_column_index As Long) As Long

    last_row_index = target_worksheet.Cells(Rows.Count, target_column_index).End(xlUp).Row
    
End Function

Function last_column_index(target_worksheet As worksheet, target_row_index As Long) As Long

    last_column_index = target_worksheet.Cells(target_row_index, Columns.Count).End(xlToLeft).Column
    
End Function

Here is an example of the output:

CodePudding user response：

I figured out the solution, posting it here to close the question:

For Each ws In Worksheets
    If ws.Name <> "Output" And ws.Name <> "indice" And ws.Name <> "aneca" Then
        For row_index = 2 To last_row_index(ws, 1)
            output_counter = last_row_index(output_ws, 1)
            For column_index = 1 To last_column_index(ws, 1)
                ws_header = ws.Cells(1, column_index).Value
                For o_column_index = 1 To max_cc
                    output_header = output_ws.Cells(1, o_column_index).Value
                    If output_header = ws_header Then
                        ws.Cells(row_index, column_index).Copy output_ws.Cells(output_counter   1, column_index)
                        Exit For
                    End If
                Next o_column_index
            Next column_index
        Next row_index
    End If
Next ws

I made an output counter variable and made it find the last row each time it starts on a new row in the input sheets, and then I add 1 to it every time it pastes a row.