Copy many sheets into one twist
 

So I have to copy 173 sheets into one list. I found the code at:

http://www.rondebruin.nl/copy2.htm

to be very helpful. I'm using the copydatawithoutheaders macro

But I need to grab information from cell B5 of each sheet and add it to the
end of the list for each item. That is if it copies 4 rows and 5 columns, I
want each row to have a 6th column with the value in cell B5 of that sheet.

The AppendDataAfterLastColumn macro doesn't do what I want, it adds the
information into a new column (or maybe I'm modifying it incorrectly).

Any help would be greatly appreciated! Thanks in advance.

Copy many sheets into one twist
 

please send your workbook to me
my



"Andy" wrote:

So I have to copy 173 sheets into one list. I found the code at:

http://www.rondebruin.nl/copy2.htm

to be very helpful. I'm using the copydatawithoutheaders macro

But I need to grab information from cell B5 of each sheet and add it to the
end of the list for each item. That is if it copies 4 rows and 5 columns, I
want each row to have a 6th column with the value in cell B5 of that sheet.

The AppendDataAfterLastColumn macro doesn't do what I want, it adds the
information into a new column (or maybe I'm modifying it incorrectly).

Any help would be greatly appreciated! Thanks in advance.

Copy many sheets into one twist
 

please paste this code to visual basic edit

Const END_COLUMN = 6
Const START_ROW = 8


Private Sub GetProductOrder(sht As Excel.Worksheet, rng As Excel.Range)
Dim intI As Long
Dim intJ As Long
For intI = START_ROW To sht.UsedRange.Rows.Count
If sht.UsedRange.Cells(intI, 1) < "" And sht.UsedRange.Cells(intI,
2) < "" Then
For intJ = 1 To END_COLUMN
rng(1, intJ).Value = sht.UsedRange.Cells(intI, intJ).Value
Next
Set rng = rng.Offset(1, 0)
End If

Next
End Sub

Public Sub MergeData()
ClearData
Dim intI As Integer
Dim rng As Excel.Range
Set rng = Worksheets("MergeSheet").Range("A2:F2")

For intI = 1 To Worksheets.Count
If LCase(Worksheets(intI).Name) < "MergeSheet" Then
Call GetProductOrder(Worksheets(intI), rng)
End If
Next
MsgBox "Merge data complete!"
End Sub

Private Sub ClearData()
Dim sht As Worksheet
Set sht = Worksheets("MergeSheet")
Dim rng As Excel.Range
Set rng = sht.UsedRange
Set rng = rng.Offset(1, 0)
rng.EntireRow.Clear
End Sub


"Andy" wrote:

So I have to copy 173 sheets into one list. I found the code at:

http://www.rondebruin.nl/copy2.htm

to be very helpful. I'm using the copydatawithoutheaders macro

But I need to grab information from cell B5 of each sheet and add it to the
end of the list for each item. That is if it copies 4 rows and 5 columns, I
want each row to have a 6th column with the value in cell B5 of that sheet.

The AppendDataAfterLastColumn macro doesn't do what I want, it adds the
information into a new column (or maybe I'm modifying it incorrectly).

Any help would be greatly appreciated! Thanks in advance.