• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Consolidate Data as per header

Abhijeet

Active Member
Hi

This macro pull active sheet Data in Sheet2 i want to pull all sheets data in sheet2 as per header please tell me how to loop this
Code:
Option Explicit
Sub CopyData()
Dim i As Integer, lastRow As Long
Dim PstRng As Range
Dim ws As Worksheet
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheet2.[2:65536].EntireRow.Delete
'For Each ws In Worksheets
For i = 1 To 256

    Set PstRng = Sheet2.Range("1:1").Find(Cells(1, i).Value, [A1], xlValues, xlWhole)
    If Not PstRng Is Nothing Then
        Range(Cells(2, i), Cells(lastRow, i)).Copy PstRng.Offset(1, 0)
    End If
Next i
'Next ws
MsgBox "Done"
End Sub
 
Hi
Please tell me i am trying to do this loop sheets is this correct method
Code:
Option Explicit
Sub CopyData()
Dim i As Integer, lastRow As Long
Dim PstRng As Range
Dim ws As Worksheet
Dim lrow As Long
Dim sht3 As Worksheet


Set sht2 = Worksheets("Macro Data")

sht3.[2:65536].EntireRow.Delete
For Each ws In Worksheets
    If ws.Name <> "Macro Data" Then
        ws.Select
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    lrow = sht3.Range("A" & Rows.Count).End(xlUp).Row
 
   
For i = 1 To 15
    Set PstRng = sht3.Range("1:1").Find(Cells(1, i).Value, [A1], xlValues, xlWhole)
    If Not PstRng Is Nothing Then
        Range(Cells(2, i), Cells(lastRow, i)).Copy PstRng.Offset(lrow, 0)
    End If
Next i
End If
Next ws
MsgBox "Done"
End Sub
 
Back
Top