VBA Match Copy from 2 Sheets into another

[Cervani]

Hi Guys.
I have a working code matching data from sheets Information and Data with sheet Header into OUTPUT

However few columns has been added into both Information and Data, so I changed ranges span and I can get data all apart from column A which should be copied to OUTPUT but it does not.
I bypass that with some other macro but I wonder what should be done to get this working with previous code?

Data start with this:

Information

OUTPUT

Header

Workgin code before adding new columns

[/U]

Sub Get_GBSMDMData()



'Get the worksheets

Dim shGBSMDM As Worksheet, lastRowGBSMDM As Long, password As String

Set shGBSMDM = ThisWorkbook.Worksheets("OUTPUT")

password = "pass"



'Identify lastRowGBSMDM

lastRowGBSMDM = ThisWorkbook.Worksheets("OUTPUT").Cells(Rows.Count, 1).End(xlUp).row



shGBSMDM.Unprotect password:=password



Call TurnOffStuff



'Clear any existing output



Dim Cell As Range

For Each Cell In Range("GBSMDM")



If Cell.Value <> "" Then

shGBSMDM.Range("C25:C" & lastRowGBSMDM).EntireRow.Delete

End If



Next Cell



'Get SNData



lastrowHeaderAttributeSN = ThisWorkbook.Worksheets("Header").Range("A" & Rows.Count).End(xlUp).row

lastrowSNDataAttribute = ThisWorkbook.Worksheets("Information").Range("A" & Rows.Count).End(xlUp).row



For i = 2 To lastrowHeaderAttributeSN



Set rng1 = ThisWorkbook.Worksheets("Information").Range("A23:AT23")

Set rng2 = ThisWorkbook.Worksheets("OUTPUT").Range("A24:DY24")



m = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("A" & i).Value, rng1, 0)

ThisWorkbook.Worksheets("Information").Range("A24:A" & lastrowSNDataAttribute).Columns(m).Copy



h = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("A" & i).Value, rng2, 0)

ThisWorkbook.Worksheets("OUTPUT").Range("A25").Columns(h).PasteSpecial xlPasteValues



Next i



'Get SupplierData



lastrowHeaderAttributeSupp = ThisWorkbook.Worksheets("Header").Range("C" & Rows.Count).End(xlUp).row

lastrowSuppDataAttribute = ThisWorkbook.Worksheets("Data").Range("A" & Rows.Count).End(xlUp).row



For a = 2 To lastrowHeaderAttributeSupp



Set rng3 = ThisWorkbook.Worksheets("Data").Range("B25:CH25")

Set rng4 = ThisWorkbook.Worksheets("OUTPUT").Range("A24:DY24")



n = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("C" & a).Value, rng3, 0)

ThisWorkbook.Worksheets("Data").Range("B26:B" & lastrowSuppDataAttribute).Columns(n).Copy



o = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("C" & a).Value, rng4, 0)

ThisWorkbook.Worksheets("OUTPUT").Range("A25").Columns(o).PasteSpecial xlPasteValues



Next a



Application.CutCopyMode = False



Call Delete_Blank_Rows

Call TurnOnStuff



shGBSMDM.Protect password:=password, AllowSorting:=True, AllowFiltering:=True



End Sub



Sub TurnOffStuff()



Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.EnableEvents = False



End Sub





Sub TurnOnStuff()

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub



Sub Delete_Blank_Rows()



Dim rRow As Range

Dim rSelect As Range

Dim rSelection As Range



Set rSelection = Range("GBSMDM")



'Loop through each row and add blank rows to rSelect range

For Each rRow In rSelection.Rows

If WorksheetFunction.CountA(rRow) = 0 Then

If rSelect Is Nothing Then

Set rSelect = rRow

Else

Set rSelect = Union(rSelect, rRow)

End If

End If

Next rRow



'Delete blank rows

If rSelect Is Nothing Then

MsgBox "No blank rows were found.", vbOKOnly, "Select Blank Rows Macro"

Exit Sub

Else

rSelect.Rows.Delete Shift:=xlShiftUp

End If



End Sub

[U]

This is new one with extended range ( rng 1 ,2 3 and 4) and
with macro so copy that A column

[/U]
Sub Get_GBSMDMData()



'Get the worksheets

Dim shGBSMDM As Worksheet, lastRowGBSMDM As Long, password As String

Set shGBSMDM = ThisWorkbook.Worksheets("OUTPUT")

password = "pass"



'Identify lastRowGBSMDM

lastRowGBSMDM = ThisWorkbook.Worksheets("OUTPUT").Cells(Rows.Count, 1).End(xlUp).row



shGBSMDM.Unprotect password:=password



Call TurnOffStuff



'Clear any existing output



Dim Cell As Range

For Each Cell In Range("GBSMDM")



If Cell.Value <> "" Then

shGBSMDM.Range("C25:C" & lastRowGBSMDM).EntireRow.Delete

End If



Next Cell



'Get SNData



lastrowHeaderAttributeSN = ThisWorkbook.Worksheets("Header").Range("A" & Rows.Count).End(xlUp).row

lastrowSNDataAttribute = ThisWorkbook.Worksheets("Information").Range("A" & Rows.Count).End(xlUp).row



For i = 2 To lastrowHeaderAttributeSN



Set rng1 = ThisWorkbook.Worksheets("Information").Range("A23:AX23")

Set rng2 = ThisWorkbook.Worksheets("OUTPUT").Range("A24:ES24")



m = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("A" & i).Value, rng1, 0)

ThisWorkbook.Worksheets("Information").Range("A24:A" & lastrowSNDataAttribute).Columns(m).Copy



h = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("A" & i).Value, rng2, 0)

ThisWorkbook.Worksheets("OUTPUT").Range("A25").Columns(h).PasteSpecial xlPasteValues



Next i



'Get SupplierData

lastrowHeaderAttributeSupp = ThisWorkbook.Worksheets("Header").Range("C" & Rows.Count).End(xlUp).row

lastrowSuppDataAttribute = ThisWorkbook.Worksheets("Data").Range("A" & Rows.Count).End(xlUp).row

For a = 2 To lastrowHeaderAttributeSupp



Set rng3 = ThisWorkbook.Worksheets("Data").Range("B25:CW25")

Set rng4 = ThisWorkbook.Worksheets("OUTPUT").Range("A24:ES24")



n = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("C" & a).Value, rng3, 0)

ThisWorkbook.Worksheets("Data").Range("B26:B" & lastrowSuppDataAttribute).Columns(n).Copy



o = Application.WorksheetFunction.Match(ThisWorkbook.Worksheets("Header").Range("C" & a).Value, rng4, 0)

ThisWorkbook.Worksheets("OUTPUT").Range("A25").Columns(o).PasteSpecial xlPasteValues



Next a



Application.CutCopyMode = False



Call Delete_Blank_Rows

‘HERE I added macro to copy/paste first column  from Information tab

Sheets("Information").Select

Range("A24").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Sheets("OUTPUT").Select

Range("A25").Select

Selection.PasteSpecial xlPasteValues



Call TurnOnStuff



shGBSMDM.Protect password:=password, AllowSorting:=True, AllowFiltering:=True



End Sub
[U]

Thanks in advance