Combine data from multiple sheets with sheet name

RAJESH1960

Banned for repeated rules violations
Joined
Mar 26, 2020
Messages
2,313
Office Version
  1. 2019
Platform
  1. Windows
Hello guys,

This is a continuation of the earlier query. There are multiple sheets in this workbook. They may range from minimum 3 to 11 sheets. In this case it is just 3 +1 sheets.

First of all, In the old code, I need to edit the code to display (As Per Portal),in the Edited Portal sheet under the column “Data from” as shown in the Edited portal sheet and fill it down.

Secondly, I want to copy data from sheets Journal, IGST and CGST column wise, and paste it to Edited Portal below the last empty row, under the same heading. (Except Line). Here, in the portal sheet “Data from” column I want the name of the sheet (As Per Journal), (As Per IGST), (As Per CGST), respectively.

Please note, Not all headings are available in sheets Journal, IGST and CGST. But whatever is available, to be posted.

After combining the sheets, Column B, below the “Portal” last row, to enter and fill down name “Tally”. The Line number to be filled down from Portal last number to the end as shown in the expected Result sheet.

Finally, I need to color all the values where the column B contains Portal from column A to M. Green color. Format the cells to Bold.

In future, your comments (explanation) on each line, will be very helpful to combine 10 or more sheets by editing the code.

Combine each Data as sheet name.xlsm
 
No please. I won't be needing the borders. If they are there won't make much of a difference.
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Here is my first swing at it:
VBA Code:
Option Explicit

    Dim DestinationLastRow          As Long
    Dim wsDestination               As Worksheet

Sub EditPortal()
'
'solved by JohnnyL 30-03-2022
'Updated on 02-04-2022

    Dim DestinationSheetExists      As Boolean
'
    Dim ArrayColumn                 As Long, ArrayRow                   As Long
    Dim CorrectedColumn             As Long
    Dim OutputArrayRow              As Long, SourceArrayRow             As Long
    Dim SourceDataStartRow          As Long, SourceLastRow              As Long
'
    Dim DataWorkSheet               As String, DestinationSheet         As String
    Dim SourceDataLastWantedColumn  As String, SourceDataStartColumn    As String
'
    Dim OutputArray                 As Variant, SourceArray             As Variant
    Dim wsSource                    As Worksheet
'
    DestinationSheet = "Edited Portal"                          ' <--- Set this to the name of the sheet to store the shortened Portal data into
        Set wsSource = Sheets("PORTAL")                         ' <--- Set this to the Portal sheet that you want data from
'
    SourceDataLastWantedColumn = "P"                            ' <--- Set this to the last column of wanted data on the source sheet
         SourceDataStartColumn = "A"                            ' <--- Set this to the starting column of wanted data on the source sheet
            SourceDataStartRow = 7                              ' <--- Set this to the starting row of data on the source sheet
'
    On Error Resume Next                                        '   Bypass error generated in next line if sheet does not exist
    Set wsDestination = Sheets(DestinationSheet)                '   Assign DestinationSheet to wsDestination
    On Error GoTo 0                                             '   Turn Excel error handling back on
'
    If Not wsDestination Is Nothing Then DestinationSheetExists = True  '   Check to see if the DestinationSheet exists
'
' Create DestinationSheet if it doesn't exist
    If DestinationSheetExists = False Then                      '   If DestinationSheet does not exist then ...
        Sheets.Add(After:=wsSource).Name = DestinationSheet     '       Create the DestinationSheet after the Source sheet
        Set wsDestination = Sheets(DestinationSheet)            '       Assign the DestinationSheet to wsDestination
    End If
'
'---------------------------------------------------------------
'
    SourceLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row  ' Get last row used in column A of the source sheeet
'
    SourceArray = wsSource.Range(SourceDataStartColumn & SourceDataStartRow & _
            ":" & SourceDataLastWantedColumn & SourceLastRow)                           ' Load all needed data from source sheet to 2D 1 based SourceArray RC
'
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(SourceArray, 2))         '   Establish # of rows/columns in 2D 1 based OutputArray
    OutputArrayRow = 0                                                                  ' Initialize OutputArrayRow
'
    For SourceArrayRow = 1 To UBound(SourceArray, 1)                                    ' Loop through all rows of SourceArray
        If Right$(Application.Trim(SourceArray(SourceArrayRow, 3)), 6) = "-Total" Then  '   If a total cell is found in the array then ...(3 represents column C)
            OutputArrayRow = OutputArrayRow + 1                                         '       Increment OutputArrayRow
'
            OutputArray(OutputArrayRow, 1) = OutputArrayRow                     ' Row #
            OutputArray(OutputArrayRow, 2) = "PORTAL"
'
            OutputArray(OutputArrayRow, 3) = SourceArray(SourceArrayRow, 1)     ' GSTIN
            OutputArray(OutputArrayRow, 4) = SourceArray(SourceArrayRow, 2)     ' Name of supplier
'
            OutputArray(OutputArrayRow, 5) = Left$(SourceArray(SourceArrayRow, 3), Len(SourceArray(SourceArrayRow, 3)) - 6) ' Invoice #
            OutputArray(OutputArrayRow, 6) = SourceArray(SourceArrayRow, 5)     ' Invoice Date
'
            OutputArray(OutputArrayRow, 7) = SourceArray(SourceArrayRow, 11)    ' Integrated Tax
            OutputArray(OutputArrayRow, 8) = SourceArray(SourceArrayRow, 12)    ' Central Tax
            OutputArray(OutputArrayRow, 9) = SourceArray(SourceArrayRow, 13)    ' State/UT Tax
'
            OutputArray(OutputArrayRow, 11) = SourceArray(SourceArrayRow, 6)    ' Invoice value
            OutputArray(OutputArrayRow, 12) = SourceArray(SourceArrayRow, 10)   ' Taxable value
            OutputArray(OutputArrayRow, 13) = SourceArray(SourceArrayRow, 16)   ' Filing Date
            OutputArray(OutputArrayRow, 15) = "As Per Portal"
        End If
    Next
'
'---------------------------------------------------------------
'
    wsDestination.UsedRange.Clear                                                                   ' Delete previous contents from destination sheet
'
' Write all header values into the DestinationSheet
    wsDestination.Range("A1:O1").Value = Array("Line", "As Per", "GSTIN of supplier", _
            "Trade/Legal name of the Supplier", "Invoice number", "Invoice Date", _
            "Integrated Tax", "Central Tax", "State/UT", "Remarks", "Invoice Value", _
            "Taxable Value", "Filing Date", "Narration", "Data from")                               ' Write header row to DestinationSheet
'
    wsDestination.Columns("F:F").NumberFormat = "@"                                                 ' Set column to text format to prevent excel changing dates
    wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray  ' Display results to DestinationSheet
'
    DestinationLastRow = wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Row          ' Get last row used in column A of the destination sheeet
'
    wsDestination.Range("N2:N" & DestinationLastRow).Formula = "=$C$1 & "" "" & C2" & _
            " & ""  "" & $D$1 & "" "" & D2 & ""  "" & $E$1 & "" "" & E2" & _
            " & ""  "" & $F$1 & "" "" & TEXT(F2,""dd-mm-yyyy"") & ""  "" & $K$1" & _
            " & "" "" & K2 & ""  "" & $M$1 & "" "" & TEXT(M2,""DD-MM-YYYY"")"           ' Copy Narration Formula to Column N
'
    wsDestination.Range("O2:O" & DestinationLastRow) = "As Per Portal"                  ' Copy 'As Per Portal' to Column O
    wsDestination.Range("G:I", "K:L").NumberFormat = "0.00"                             ' Set columns to numeric with 2 decimal places
'
    wsDestination.Range("N2:N" & DestinationLastRow).Copy                               ' Copy formula range into memory
    wsDestination.Range("N2:N" & DestinationLastRow).PasteSpecial xlPasteValues         ' Paste just the vales back to range
    Application.CutCopyMode = False                                                     ' Clear clipboard & 'marching ants' around copied range
'
 
    wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"                              ' Format the date the way we want it to appear
    wsDestination.Columns("F:F").TextToColumns Destination:=Range("F1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                               ' Convert text to numeric
'
    wsDestination.Range("M:M").NumberFormat = "dd-mm-yyyy"                              ' Format the date the way we want it to appear
    wsDestination.Columns("M:M").TextToColumns Destination:=Range("M1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                               ' Convert text to numeric
'
    wsDestination.Range("B2:M" & DestinationLastRow).Interior.Color = RGB(146, 208, 80) ' Highlight the range green
    wsDestination.Range("B2:M" & DestinationLastRow).Font.Bold = True                   ' Make the range Bold
'
'---------------------------------------------------------------
'
    DataWorkSheet = "Journal"                                                           ' Establish sheet name to pass to subroutine
'
    Call GetDataFromDataSheet(DataWorkSheet)
'
    DataWorkSheet = "IGST"                                                              ' Establish sheet name to pass to subroutine
'
    Call GetDataFromDataSheet(DataWorkSheet)
'
    DataWorkSheet = "CGST"                                                              ' Establish sheet name to pass to subroutine
'
    Call GetDataFromDataSheet(DataWorkSheet)
'
    wsDestination.UsedRange.EntireColumn.AutoFit                                        ' Autofit all of the columns on the DestinationSheet
End Sub


Sub GetDataFromDataSheet(DataWorkSheet As String)
'
    Dim ArrayColumn                 As Long, ArrayRow       As Long
    Dim CorrectedColumn             As Long
    Dim DataLastColumn              As String, DataLastRow  As Long, DestinationStartRow    As Long
    Dim CorrectedDataArray          As Variant
    Dim DataSheetArray              As Variant
'
    DataLastRow = Sheets(DataWorkSheet).Range("B" & _
            Sheets(DataWorkSheet).Rows.Count).End(xlUp).Row                             ' Get last row of the Data sheet column B
'
    DataLastColumn = Split(Cells(1, (Sheets(DataWorkSheet).Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)          ' Get last column letter of the Data sheet
'
    DataSheetArray = Sheets(DataWorkSheet).Range("A2:" & _
            DataLastColumn & DataLastRow)                                               ' Load Data from Data sheet to 2D 1 based DataSheetArray
'
    ReDim CorrectedDataArray(1 To UBound(DataSheetArray, 1), _
            1 To UBound(DataSheetArray, 2) - 2)                                         ' Set the number of rows & columns for the CorrectedDataArray
'
    CorrectedColumn = 0                                                                 ' Initialize CorrectedColumn
'
    For ArrayRow = 1 To UBound(DataSheetArray, 1)                                       ' Loop through the rows of DataSheetArray
        For ArrayColumn = 2 To UBound(DataSheetArray, 2)                                '   Loop through the columns of DataSheetArray
            If ArrayColumn = 3 Then GoTo NextColumn                                     '       Skip the 3rd column, we don't need it right now
'
            CorrectedColumn = CorrectedColumn + 1                                       '       Increment CorrectedColumn
'
            CorrectedDataArray(ArrayRow, CorrectedColumn) = _
                    DataSheetArray(ArrayRow, ArrayColumn)                               '       Save DataSheetArray data into CorrectedDataArray
NextColumn:
        Next                                                                            '   Loop back
'
        CorrectedColumn = 0                                                             '   Reset CorrectedColumn
    Next                                                                                ' Loop back
'
    DestinationStartRow = DestinationLastRow + 1                                        ' Save DestinationLastRow + 1 into DestinationStartRow
'
    wsDestination.Range("B" & DestinationStartRow).Resize(UBound(CorrectedDataArray, _
            1), UBound(CorrectedDataArray, 2)) = CorrectedDataArray                     ' Display Results to destination sheet
'
    DestinationLastRow = wsDestination.Range("B" & _
            wsDestination.Rows.Count).End(xlUp).Row                                     ' Recalculate last row used in column B of the destination sheeet
'
    wsDestination.Range("O" & DestinationStartRow & ":O" & _
            DestinationLastRow) = DataSheetArray(1, 3)                                  ' Copy 'As Per ????' to Column O
'
    wsDestination.Range("A" & DestinationStartRow & _
            ":A" & DestinationLastRow).Formula = "=Row() - 1"                           ' Use formula to set row #s
    wsDestination.Range("A" & DestinationStartRow & ":A" & DestinationLastRow).Copy     ' Copy formula range into memory
    wsDestination.Range("A" & DestinationStartRow & ":A" & _
            DestinationLastRow).PasteSpecial xlPasteValues                              ' Paste just the vales back to range
    Application.CutCopyMode = False                                                     ' Clear clipboard & 'marching ants' around copied range
End Sub

I also incorporated yet another different style of coding for you to learn from. :)
 
Upvote 0
Wow, Marvelous, astounding.. Your first swing sent the ball out of the ground.
Now I will try and add sheets the way you did it by copying this data in the code multiple times and check it out.
Rich (BB code):
DataWorkSheet = "Journal"
What if I incorporate multiple sheet names in this like
Rich (BB code):
DataWorkSheet = "Journal" , "IGST", "CGST"
will try both the styles and will let you know.
The saga continues.......
 
Upvote 0
Wow, Marvelous, astounding.. Your first swing sent the ball out of the ground.
Now I will try and add sheets the way you did it by copying this data in the code multiple times and check it out.
Rich (BB code):
DataWorkSheet = "Journal"
What if I incorporate multiple sheet names in this like
Rich (BB code):
DataWorkSheet = "Journal" , "IGST", "CGST"
will try both the styles and will let you know.
The saga continues.......
I failed to notice that you have already included all the sheets.
 
Upvote 0
JohnnyL. I found one error in the code. The yellow marked column in sheets Journal, IGST, CGST were the expected result. I have to get As Per + Sheet Name in that column. The same way you got the As per Portal in the Portal rows.
Rich (BB code):
 wsDestination.Range("O" & DestinationStartRow & ":O" & _
            DestinationLastRow) = DataSheetArray(1, 3)                                  ' Copy 'As Per ????' to Column O
 
Upvote 0
I am sorry if I forgot to mention that the yellow columns in the Journal, IGST, CGST are blank and the code should fill the column.
 
Upvote 0
You can continue in this updated workbook. The Data from column is the only thing pending in this query.
Combine sheet data 03.04.2022.xlsm
If anything else will let you know. Checking with original data base now.
 
Upvote 0
Swing #2:

VBA Code:
    Option Explicit

    Dim DestinationLastRow          As Long
    Dim wsDestination               As Worksheet

Sub EditPortal()
'
'solved by JohnnyL 30-03-2022
'Updated on 02-04-2022
'UPDATED ON 03-04-2022
'
    Dim DestinationSheetExists      As Boolean
    Dim ArrayColumn                 As Long, ArrayRow                   As Long
    Dim CorrectedColumn             As Long
    Dim OutputArrayRow              As Long, SourceArrayRow             As Long
    Dim SourceDataStartRow          As Long, SourceLastRow              As Long
    Dim DataWorkSheet               As String, DestinationSheet         As String
    Dim SourceDataLastWantedColumn  As String, SourceDataStartColumn    As String
    Dim OutputArray                 As Variant, SourceArray             As Variant
    Dim wsSource                    As Worksheet, ws                    As Worksheet
'
    DestinationSheet = "Edited Portal"                          ' <--- Set this to the name of the sheet to store the shortened Portal data into
        Set wsSource = Sheets("PORTAL")                         ' <--- Set this to the Portal sheet that you want data from
'
    SourceDataLastWantedColumn = "P"                            ' <--- Set this to the last column of wanted data on the source sheet
         SourceDataStartColumn = "A"                            ' <--- Set this to the starting column of wanted data on the source sheet
            SourceDataStartRow = 7                              ' <--- Set this to the starting row of data on the source sheet
'
    On Error Resume Next                                        '   Bypass error generated in next line if sheet does not exist
    Set wsDestination = Sheets(DestinationSheet)                '   Assign DestinationSheet to wsDestination
    On Error GoTo 0                                             '   Turn Excel error handling back on
'
    If Not wsDestination Is Nothing Then DestinationSheetExists = True  '   Check to see if the DestinationSheet exists
'
' Create DestinationSheet if it doesn't exist
    If DestinationSheetExists = False Then                      '   If DestinationSheet does not exist then ...
        Sheets.Add(After:=wsSource).Name = DestinationSheet     '       Create the DestinationSheet after the Source sheet
        Set wsDestination = Sheets(DestinationSheet)            '       Assign the DestinationSheet to wsDestination
    End If
'
'---------------------------------------------------------------
'
    SourceLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row  ' Get last row used in column A of the source sheeet
'
    SourceArray = wsSource.Range(SourceDataStartColumn & SourceDataStartRow & _
            ":" & SourceDataLastWantedColumn & SourceLastRow)                           ' Load all needed data from source sheet to 2D 1 based SourceArray RC
'
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(SourceArray, 2))         '   Establish # of rows/columns in 2D 1 based OutputArray
    OutputArrayRow = 0                                                                  ' Initialize OutputArrayRow
'
    For SourceArrayRow = 1 To UBound(SourceArray, 1)                                    ' Loop through all rows of SourceArray
        If Right$(Application.Trim(SourceArray(SourceArrayRow, 3)), 6) = "-Total" Then  '   If a total cell is found in the array then ...(3 represents column C)
            OutputArrayRow = OutputArrayRow + 1                                         '       Increment OutputArrayRow
'
            OutputArray(OutputArrayRow, 1) = OutputArrayRow                     ' Row #
            OutputArray(OutputArrayRow, 2) = "PORTAL"
'
            OutputArray(OutputArrayRow, 3) = SourceArray(SourceArrayRow, 1)     ' GSTIN
            OutputArray(OutputArrayRow, 4) = SourceArray(SourceArrayRow, 2)     ' Name of supplier
'
            OutputArray(OutputArrayRow, 5) = Left$(SourceArray(SourceArrayRow, 3), Len(SourceArray(SourceArrayRow, 3)) - 6) ' Invoice #
            OutputArray(OutputArrayRow, 6) = SourceArray(SourceArrayRow, 5)     ' Invoice Date
'
            OutputArray(OutputArrayRow, 7) = SourceArray(SourceArrayRow, 11)    ' Integrated Tax
            OutputArray(OutputArrayRow, 8) = SourceArray(SourceArrayRow, 12)    ' Central Tax
            OutputArray(OutputArrayRow, 9) = SourceArray(SourceArrayRow, 13)    ' State/UT Tax
'
            OutputArray(OutputArrayRow, 11) = SourceArray(SourceArrayRow, 6)    ' Invoice value
            OutputArray(OutputArrayRow, 12) = SourceArray(SourceArrayRow, 10)   ' Taxable value
            OutputArray(OutputArrayRow, 13) = SourceArray(SourceArrayRow, 16)   ' Filing Date
            OutputArray(OutputArrayRow, 15) = "As Per Portal"
        End If
    Next
'
'---------------------------------------------------------------
'
    wsDestination.UsedRange.Clear                                                                   ' Delete previous contents from destination sheet
'
' Write all header values into the DestinationSheet
    wsDestination.Range("A1:O1").Value = Array("Line", "As Per", "GSTIN of supplier", _
            "Trade/Legal name of the Supplier", "Invoice number", "Invoice Date", _
            "Integrated Tax", "Central Tax", "State/UT", "Remarks", "Invoice Value", _
            "Taxable Value", "Filing Date", "Narration", "Data from")                               ' Write header row to DestinationSheet
'
    wsDestination.Columns("F:F").NumberFormat = "@"                                                 ' Set column to text format to prevent excel changing dates
    wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray  ' Display results to DestinationSheet
'
    DestinationLastRow = wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Row          ' Get last row used in column A of the destination sheeet
'
    wsDestination.Range("N2:N" & DestinationLastRow).Formula = "=$C$1 & "" "" & C2" & _
            " & ""  "" & $D$1 & "" "" & D2 & ""  "" & $E$1 & "" "" & E2" & _
            " & ""  "" & $F$1 & "" "" & TEXT(F2,""dd-mm-yyyy"") & ""  "" & $K$1" & _
            " & "" "" & K2 & ""  "" & $M$1 & "" "" & TEXT(M2,""DD-MM-YYYY"")"           ' Copy Narration Formula to Column N
'
    wsDestination.Range("O2:O" & DestinationLastRow) = "As Per Portal"                  ' Copy 'As Per Portal' to Column O
    wsDestination.Range("G:I", "K:L").NumberFormat = "0.00"                             ' Set columns to numeric with 2 decimal places
'
    wsDestination.Range("N2:N" & DestinationLastRow).Copy                               ' Copy formula range into memory
    wsDestination.Range("N2:N" & DestinationLastRow).PasteSpecial xlPasteValues         ' Paste just the vales back to range
    Application.CutCopyMode = False                                                     ' Clear clipboard & 'marching ants' around copied range
'
 
    wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"                              ' Format the date the way we want it to appear
    wsDestination.Columns("F:F").TextToColumns Destination:=Range("F1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                               ' Convert text to numeric
'
    wsDestination.Range("M:M").NumberFormat = "dd-mm-yyyy"                              ' Format the date the way we want it to appear
    wsDestination.Columns("M:M").TextToColumns Destination:=Range("M1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                               ' Convert text to numeric
'
    wsDestination.Range("B2:M" & DestinationLastRow).Interior.Color = RGB(146, 208, 80) ' Highlight the range green
    wsDestination.Range("B2:M" & DestinationLastRow).Font.Bold = True                   ' Make the range Bold
'
'---------------------------------------------------------------
'
    For Each ws In Worksheets                                                           ' Loop through all worksheets in the workbook
        If ws.Name <> "PORTAL" And ws.Name <> "Expected Result" And _
                ws.Name <> "Edited Portal" Then                                         '   If sheet name is not excluded then
            Call GetDataFromDataSheet(ws.Name)                                          '       Pass sheet name to the sub routine
        End If
    Next                                                                                ' Loop back
'
    wsDestination.UsedRange.EntireColumn.AutoFit                                        ' Autofit all of the columns on the DestinationSheet
End Sub


Sub GetDataFromDataSheet(DataWorkSheet As String)
'
    Dim ArrayColumn                 As Long, ArrayRow       As Long
    Dim CorrectedColumn             As Long
    Dim DataLastColumn              As String, DataLastRow  As Long, DestinationStartRow    As Long
    Dim CorrectedDataArray          As Variant
    Dim DataSheetArray              As Variant
'
    DataLastRow = Sheets(DataWorkSheet).Range("B" & _
            Sheets(DataWorkSheet).Rows.Count).End(xlUp).Row                             ' Get last row of the Data sheet column B
'
    DataLastColumn = Split(Cells(1, (Sheets(DataWorkSheet).Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)          ' Get last column letter of the Data sheet
'
    Sheets(DataWorkSheet).Range("C2:C" & DataLastRow) = "AS PER " & DataWorkSheet       ' Copy 'AS PER ' & sheet name to Column C of the sheet
'
    DataSheetArray = Sheets(DataWorkSheet).Range("A2:" & _
            DataLastColumn & DataLastRow)                                               ' Load Data from Data sheet to 2D 1 based DataSheetArray
'
    ReDim CorrectedDataArray(1 To UBound(DataSheetArray, 1), _
            1 To UBound(DataSheetArray, 2) - 2)                                         ' Set the number of rows & columns for the CorrectedDataArray
'
    CorrectedColumn = 0                                                                 ' Initialize CorrectedColumn
'
    For ArrayRow = 1 To UBound(DataSheetArray, 1)                                       ' Loop through the rows of DataSheetArray
        For ArrayColumn = 2 To UBound(DataSheetArray, 2)                                '   Loop through the columns of DataSheetArray
            If ArrayColumn = 3 Then GoTo NextColumn                                     '       Skip the 3rd column, we don't need it right now
'
            CorrectedColumn = CorrectedColumn + 1                                       '       Increment CorrectedColumn
'
            CorrectedDataArray(ArrayRow, CorrectedColumn) = _
                    DataSheetArray(ArrayRow, ArrayColumn)                               '       Save DataSheetArray data into CorrectedDataArray
NextColumn:
        Next                                                                            '   Loop back
'
        CorrectedColumn = 0                                                             '   Reset CorrectedColumn
    Next                                                                                ' Loop back
'
    DestinationStartRow = DestinationLastRow + 1                                        ' Save DestinationLastRow + 1 into DestinationStartRow
'
    wsDestination.Range("B" & DestinationStartRow).Resize(UBound(CorrectedDataArray, _
            1), UBound(CorrectedDataArray, 2)) = CorrectedDataArray                     ' Display Results to destination sheet
'
    DestinationLastRow = wsDestination.Range("B" & _
            wsDestination.Rows.Count).End(xlUp).Row                                     ' Recalculate last row used in column B of the destination sheeet
'
    wsDestination.Range("O" & DestinationStartRow & ":O" & _
            DestinationLastRow) = DataSheetArray(1, 3)                                  ' Copy 'As Per ????' to Column O
'
    wsDestination.Range("A" & DestinationStartRow & _
            ":A" & DestinationLastRow).Formula = "=Row() - 1"                           ' Use formula to set row #s
    wsDestination.Range("A" & DestinationStartRow & ":A" & DestinationLastRow).Copy     ' Copy formula range into memory
    wsDestination.Range("A" & DestinationStartRow & ":A" & _
            DestinationLastRow).PasteSpecial xlPasteValues                              ' Paste just the vales back to range
    Application.CutCopyMode = False                                                     ' Clear clipboard & 'marching ants' around copied range
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,215,011
Messages
6,122,677
Members
449,092
Latest member
tayo4dgacorbanget

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top