Copying specific cell ranges from a worksheet multiple times to a newsheet

[Kris Winntech]

Here is what I have:

I have a workbook with multiple worksheets. Each worksheet corresponds to a certain store fixture estimate. Ont these sheets I have a specific cell where you can input how many fixtures of that type are to be used.

On that sheet also, is a range of cells (ex. Range("A65:F3340")) that needs to be copied to a new summations sheet of total hours to build the project.

If sheet 1 has 1 fixture - the macro should copy the range of cells only once.
Sheet 2 has 4 fixtures - tha macro should copy the same range four times appending each set of data tot eh end of the previous, And so on for each fixture sheet.

How would I write a macro to do this? I can provide a sample workbook if needed. Thanks.

EggHeadCafe - Software Developer Portal of Choice
VIsual Studio.NET 2005 ClickOnce Technology: An Overview
http://www.eggheadcafe.com/tutorial...78-83df87ae7c04/visual-studionet-2005-cl.aspx

 

[JLGWhiz]

This assumes that the range containing the items is A2:A20. You can change
that to the actual range. Also change the sheet names to the actual sheets
used.

Sub GetBOM()
Dim rng As Range, sh1 As Worksheet, sh2 As Worksheet
Set sh1 = ActiveSheet
Set sh2 = Sheets("Sheet2") 'Change as required
Set rng = sh1.Range("A2:A20")
mult = Application.InputBox("Enter the quantity of fixtures", _
"FIXTURE QTY", Type:=1)
For i = 1 To mult
x = sh2.Cells(Rows.Count, 1).End(xlUp).Offset(2).Address
rng.Copy sh2.Range(x)
Next
End Sub

 

[Kris Winntech]

How would I loop this to make it work for all sheets in the workbook?



JLGWhiz wrote:

This assumes that the range containing the items is A2:A20.
09-Nov-09

This assumes that the range containing the items is A2:A20. You can chang
that to the actual range. Also change the sheet names to the actual sheet
used

Sub GetBOM(
Dim rng As Range, sh1 As Worksheet, sh2 As Workshee
Set sh1 = ActiveShee
Set sh2 = Sheets("Sheet2") 'Change as require
Set rng = sh1.Range("A2:A20"
mult = Application.InputBox("Enter the quantity of fixtures",
"FIXTURE QTY", Type:=1
For i = 1 To mul
x = sh2.Cells(Rows.Count, 1).End(xlUp).Offset(2).Addres
rng.Copy sh2.Range(x
Nex
End Sub

Previous Posts In This Thread:

EggHeadCafe - Software Developer Portal of Choice
Working with Client Side Xml Data Islands from Server-Side ASP.NET code
http://www.eggheadcafe.com/tutorial...a9-e41f967e573b/working-with-client-side.aspx

 

[JLGWhiz]

If there is a constant cell on each sheet that
indicates the number of fixtures for that sheet,
you could also eliminate the input box by making
mult = that cell value. Otherwise you are stuck
with the input box. I did not test this revision,
but it should go through all the sheets in the
active workbook. Again, change sheet names and range
references to actual.

Sub GetBOM()
Dim rng As Range, sh1 As Worksheet, sh2 As Worksheet
For Each sh1 In ThisWorkbook.Sheets
If sh1.Name <> "Sheet2" 'To ignore if is summation sheet
Set sh2 = Sheets("Sheet2") 'Change as required
Set rng = sh1.Range("A2:A20")
mult = Application.InputBox("Enter the quantity of fixtures", _
"FIXTURE QTY", Type:=1)
For i = 1 To mult
x = sh2.Cells(Rows.Count, 1).End(xlUp).Offset(2).Address
rng.Copy sh2.Range(x)
Next
End If
Next
End Sub