Copying columns from multiple sheets to master

[Uptickdk]

I have a number of worksheets and need to copy G2:G9999999 from each worksheet onto Sheet1 called ("Parameters") starting in column K then L, M... I also need to copy the name of each worksheet into the top cell of the column it's data was copied into. i.e. K1, L1,M1 ... I also need to copy the any of the sheets column A2:A2500 into my "Parameters" worksheet in column J, they are dates

I'm a Newbee with VBA and not sure what my errors are or how to combine all three to subs into one.

Lastly I would like to delete any columns from J onward before running the script.

Thanks for any help,
Doug



Sub Getdata()
Dim wrk As Workbook
Dim wkst As Worksheet
Dim Column As Long
Column = 11

Set wrk = ActiveWorkbook

For Each wkst In wrk.Worksheets
' loop through all Open worksheets
If wkst.Name <> "Parameters" Then
Worksheets("Parameters").Cells(1, Column) = wkst.Range("G2:G2500")
Column = Column + 1
End If
Next
End Sub
Sub GetName()
Dim wrk As Workbook
Dim wkst As Worksheet
Dim Column As Long
Column = 11

Set wrk = ActiveWorkbook

For Each wkst In wrk.Worksheets
' loop through all Open worksheets
If wkst.Name <> "Parameters" Then
Worksheets("Parameters").Cells(1, Column).Value = wkst.Name
Column = Column + 1
End If
Next
End Sub
Sub GetDates()
Dim wrk As Workbook
Dim wkst As Worksheet
Set wrk = ActiveWorkbook
Sheets("A11").Select
Worksheet("A11").Range("a2:a2500").Select
Selection.Copy
Sheets("Parameters").Select
Range("J1").Select
ActiveSheet.Paste
End Sub

[patel]

attach please a small sample file for testing

[Uptickdk]

sheet1 shows the output after running the script

[patel]

Sub Getdata()
Dim wrk As Workbook, wkst As Worksheet, Column As Long
Column = 11
Nrows = 2500
Set wrk = ActiveWorkbook
For Each wkst In wrk.Worksheets
' loop through all Open worksheets
If wkst.Name <> "Parameters" Then
Worksheets("Parameters").Cells(1, Column).Value = wkst.Name
wkst.Range("G3:G" & Nrows).Copy Worksheets("Parameters").Cells(2, Column)
Column = Column + 1
End If
Next
Worksheets("A11").Range("a2:a" & Nrows).Copy Sheets("Parameters").Range("J1")
End Sub

[Uptickdk]

I tried your script but it first had a "Sub or Function not define" so I added Nrows As Long to Dim.
When I run it now I get a run time error '9' subscript out of range. Debugging highlights Worksheets("Parameters").Cells(1, Column).Value = wkst.Name

Also to clarify after Next
Worksheets("A11") in cell A11 is the name of the first worksheet. I was not sure if I could reference the Worksheet name with another cell. But my goal was to copy the dates in column A from any of the worksheets.
Thanks,

[patel]

attach please a good small file with good sheets names

[Uptickdk]

I have modified the example file this should give you a better visual of what I am trying to do.

Thanks,

[patel]

I don't like loose time, I'll help you only with real sheets names, data are not important

[Uptickdk]

The names of the sheets change every time I run another macro which is why I need to have the columns deleted. Starting in A11 I put a list which will then become the sheet names and there could be 30 or 150 in the list. The sheet names will look something like: RDC, PHY, RSP, ALP, RXA, PXC...

[Uptickdk]

same file but with updated sheet names.

[patel]

Sub Getdata()
Dim Column As Long
Column = 11
Nrows = 2500
For r = 11 To 15 ' you can change 15
shname = Sheets("Parameters").Cells(r, 1)
Sheets("Parameters").Cells(1, Column).Value = shname
Sheets(shname).Range("G3:G" & Nrows).Copy Sheets("Parameters").Cells(2, Column)
Column = Column + 1
Next
ndate = Sheets("Parameters").Cells(11, 1)
Sheets(ndate).Range("a2:a" & Nrows).Copy Sheets("Parameters").Range("J1")
End Sub

[Uptickdk]

Thank you. Your code works great. I have been trying to add code that will reference the last row # of column A so that you do not have to manually change the "15" number each time I run the macro.

But being new to VBAs I can't seem to integrate it into your clean code.
Any thoughts?
Thanks again,
Doug

[Uptickdk]

I add the following and modified the For line. now I can clear old data and populate with new and not worry if new population was not as large as previous one.


Range("J:CC").Clear
lastSym = Range("A11:A200").End(xlDown).Row
For r = 11 To lastSym 'find last row with text in it

[patel]

very good :thumb