need help! macro copy columns from multiple sheets to one.

[oddworld]

hi all i have a workbook containing 10 sheets. each sheet has a header row, however the headings are not in the same order (out of my control). I am working with the below code, its copying my specific columns of data to the master sheet"Master", but it is over writing each sheets data until the last sheet. I would appreciate some assistance in looping through and aggregating all 10 sheets worth of data (of the 4 specific columns) being pasted into the master sheet. So the 10 sheets combined should amount to 1500 rows of data in 4 columns.The 4 column heading exist in each sheet but in different locations.

[/SIZE]
Sub Copy_specific_columns()
  Dim ws As Worksheet
  
  For Each ws In ActiveWorkbook.Worksheets
  
  EMPLID = WorksheetFunction.Match("EMPLID", Rows("1:1"), 0)
  ACTL_UNIT = WorksheetFunction.Match("ACTL_UNIT", Rows("1:1"), 0)
  RULE_ID = WorksheetFunction.Match("RULE_ID", Rows("1:1"), 0)
  SERVICE = WorksheetFunction.Match("SERVICE", Rows("1:1"), 0)
  
  ws.Columns(EMPLID).Copy Destination:=Sheets("Master").Range("A1")
  ws.Columns(ACTL_UNIT).Copy Destination:=Sheets("Master").Range("B1")
  ws.Columns(RULE_ID).Copy Destination:=Sheets("Master").Range("C1")
  ws.Columns(SERVICE).Copy Destination:=Sheets("Master").Range("D1")
  
  Next ws
  
End Sub
 
Regards,
Odd

 

[Marc L]

Hi,

as per forum rules, attach a sample workbook with source worksheets
and desired result one …
​

 

[John()]

Ok try this out on supplied sheet .... it checks each sheet for the required column name and adds the data in the cells to the master sheet in their colum
test it on my supplied sheet as i had to guess your set up ... eg master sheet is sheet one .... then next 7 sheets are the data (know you said 10 but will work for any amount so decided 7 was enough to work with)
any problems post back.....

oh and im new to programming ... but have tested it numerous times to make sure it works

Sub Copy_specific_columns()
Application.ScreenUpdating = False
Dim nameS(0 To 4) As String, i As Integer
nameS(0) = "EMPLID"
nameS(1) = "ACTL_UNIT"
nameS(2) = "RULE_ID"
nameS(3) = "SERVICE"
i = 0
'x is 2 as i have master sheet as sheet 1 so its starting
'its checks from sheet 2 onwards
For x = 2 To Worksheets.Count
Worksheets(x).Select
For i = 0 To UBound(nameS) - 1
colN = WorksheetFunction.Match(nameS(i), Rows("1:1"), 0)
del = Cells(Rows.Count, colN).End(xlUp).Row

areA = Range(Cells(2, colN), Cells(del, colN)).Select
many = Selection.Count
pa = Selection.Value

del4 = ""
Worksheets(1).Select
del4 = Cells(Rows.Count, colN).End(xlUp).Row
del3 = Cells(Rows.Count, i + 1).End(xlUp).Row + 1
colEnd = del3 + many - 1
Range(Cells(del3, i + 1), Cells(colEnd, i + 1)).Select

Selection.Value = pa
Worksheets(x).Select
Next i
Next x
Worksheets(1).Select
Range("A1").Select
Application.ScreenUpdating = True
  End Sub

 

[oddworld]

Fantastic, gold dust, thanx John()