VBA CODE : copy data from sheets based on the column headers

[Monty]

Hello Everyone

Looking for experts advise.

Excel file attached for easy understanding.

I have used all dummy data and nothing to do with data massage as such.

We need to loop though this table and copy data from sheet 1 first and then sheet2 and append in the sheet1.

Thanking you in advance

 

[p45cal]

try:

Sub blah()
Set Destn = Sheets("Main Sheet").Range("E2")
For Each sht In Sheets
  If sht.Name <> Destn.Parent.Name Then
  Destn.Value = sht.Name
  sht.Range("A1:C1").Copy
  Destn.Offset(1).PasteSpecial Transpose:=True
  Set Destn = Destn.Offset(, 1)
  End If
Next sht
End Sub

 

[Monty]

Hello.

Thanks for the code which works...

But what I was looking here..As per the table in sheet1 column name is Country but in second sheet it is Stay....so it has to loop through the table and check if it exist in sheet2 ...then copy and happened under sheet1 country and so on...as it is defined in table so ad to if column changes macro should work by looking at table which is in main sheet.

Hope I may clear..Pls let me know any questions... Thanks.

 

[p45cal]

try:

Sub blah()
Set myTable = Sheets("Main Sheet").Range("E2").CurrentRegion
Set DestnSht = Sheets(myTable.Cells(1).Value)
DestnRow = DestnSht.Cells(Rows.Count, "A").End(xlUp).Row + 1
ofset = 0
For Each shtName In Intersect(myTable.Rows(1), myTable.Offset(, 1)).Value
  ofset = ofset + 1
  Set SourceSht = Sheets(shtName)
  SourceShtLastRow = SourceSht.Cells(Rows.Count, "A").End(xlUp).Row
  If SourceShtLastRow > 1 Then
    For Each cll In Intersect(myTable.Columns(1), myTable.Offset(1)).Cells
      Application.Goto cll
      DestnColm = Application.Match(cll.Value, DestnSht.Rows(1), 0)
      If Not IsError(DestnColm) Then
        Application.Goto cll.Offset(, ofset)
        SourceColm = Application.Match(cll.Offset(, ofset).Value, SourceSht.Rows(1), 0)
        If Not IsError(SourceColm) Then
          Application.Goto SourceSht.Cells(2, SourceColm).Resize(SourceShtLastRow - 1)
          Application.Goto DestnSht.Cells(DestnRow, DestnColm)
          SourceSht.Cells(2, SourceColm).Resize(SourceShtLastRow - 1).Copy DestnSht.Cells(DestnRow, DestnColm)
        End If
      End If
    Next cll
    DestnRow = DestnRow + SourceShtLastRow - 1
  End If
Next shtName
End Sub

Not very robust.

 

[Monty]

Hello p45cal

---Sorry for the delayed response.

I have tried the piece of code you have provided and tried all the different way to test and it's magic ...it is Successfully working.

One last request...If any column as seen as "Drag" can we drag last cell to till the size of the data.




Example as highlighted.




As the column name mentioned as "Drag" so just dragging whatever the last cell mentioned..

Hope i am clear with my view.

Regards
Monty.

 

[p45cal]

In my code submission, I forgot to remove all lines which begin with
Application.GoTo…
They're what I used for debugging.

I can't make head or tail of what you want to happen when Drag is encountered.

 

[Monty]

Hello P45cal..

Thanks for your efforts...That was the only piece of requirement pending trying too hard from my end as well as some columns will not have data it is just drag from the previous cell as shown in the example...

Thanks you are a champ.