ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   how to copy a cell multiple times and in many worksheets (https://www.excelbanter.com/excel-programming/408774-how-copy-cell-multiple-times-many-worksheets.html)

Jerry

how to copy a cell multiple times and in many worksheets
 
I have a spreadsheet where I need to copy multiple cells every other column
and applicable to other worksheets. Under Set wks = Worksheets("mardet")
I need to put 12 worksheet names (febdet, mardet, aprdet) for the 12 months
of the year. Under Set myRng = .Range("c6:e20,g6:i20") I need to run this
loop 25 times for as to read 3 columns(c thru e), skip one column (f) and do
3 columns (g - i) and skip a column (j) and so on. The code that I use for a
worksheet is below. Your asistance is greatly appreciated

Option Explicit
Sub testme01()

Dim GrpBox As GroupBox
Dim OptBtn As OptionButton
Dim wks As Worksheet
Dim myCell As Range
Dim myRng As Range

Set wks = Worksheets("mardet")

With wks
'nice for testing
.OptionButtons.Delete
.GroupBoxes.Delete

Set myRng = .Range("c6:e20,g6:i20")
For Each myCell In myRng.Cells
With myCell
Set GrpBox = .Parent.GroupBoxes.Add(Top:=.Top, _
Left:=.Left, _
Width:=.Width, _
Height:=.Height)
GrpBox.Caption = ""
GrpBox.Visible = False

Set OptBtn = .Parent.OptionButtons.Add(Top:=.Top, _
Left:=.Left, _
Width:=.Width / 2, _
Height:=.Height)
OptBtn.Caption = ""
OptBtn.LinkedCell = .Address(external:=True)

Set OptBtn = .Parent.OptionButtons.Add(Top:=.Top, _
Left:=.Left + (.Width / 2), _
Width:=.Width / 2, _
Height:=.Height)
OptBtn.Caption = ""

.NumberFormat = ";;;"

End With
Next myCell
End With
End Sub
Sub compliance()

End Sub

Jerry

how to copy a cell multiple times and in many worksheets
 
Dave:
I copied the modified code and it works for the 1st worksheet. It took over
30 minutes to fill in the cells in one of the worksheets, with the old code
it took 3secs to fill in a block of 3 cols (C6:E20). I am thinking there is
loop that is slowing the process.

"Jerry" wrote:

I have a spreadsheet where I need to copy multiple cells every other column
and applicable to other worksheets. Under Set wks = Worksheets("mardet")
I need to put 12 worksheet names (febdet, mardet, aprdet) for the 12 months
of the year. Under Set myRng = .Range("c6:e20,g6:i20") I need to run this
loop 25 times for as to read 3 columns(c thru e), skip one column (f) and do
3 columns (g - i) and skip a column (j) and so on. The code that I use for a
worksheet is below. Your asistance is greatly appreciated

Option Explicit
Sub testme01()

Dim GrpBox As GroupBox
Dim OptBtn As OptionButton
Dim wks As Worksheet
Dim myCell As Range
Dim myRng As Range

Set wks = Worksheets("mardet")

With wks
'nice for testing
.OptionButtons.Delete
.GroupBoxes.Delete

Set myRng = .Range("c6:e20,g6:i20")
For Each myCell In myRng.Cells
With myCell
Set GrpBox = .Parent.GroupBoxes.Add(Top:=.Top, _
Left:=.Left, _
Width:=.Width, _
Height:=.Height)
GrpBox.Caption = ""
GrpBox.Visible = False

Set OptBtn = .Parent.OptionButtons.Add(Top:=.Top, _
Left:=.Left, _
Width:=.Width / 2, _
Height:=.Height)
OptBtn.Caption = ""
OptBtn.LinkedCell = .Address(external:=True)

Set OptBtn = .Parent.OptionButtons.Add(Top:=.Top, _
Left:=.Left + (.Width / 2), _
Width:=.Width / 2, _
Height:=.Height)
OptBtn.Caption = ""

.NumberFormat = ";;;"

End With
Next myCell
End With
End Sub
Sub compliance()

End Sub


Dave Peterson

how to copy a cell multiple times and in many worksheets
 
There's a couple of loops (and you missed a change to the code):

For mCtr = 1 To 1 '12 when you're done testing!
becomes
For mCtr = 1 To 12

And you're adding lots and lots more objects. That why I warned you.

Jerry wrote:

Dave:
I copied the modified code and it works for the 1st worksheet. It took over
30 minutes to fill in the cells in one of the worksheets, with the old code
it took 3secs to fill in a block of 3 cols (C6:E20). I am thinking there is
loop that is slowing the process.

"Jerry" wrote:

I have a spreadsheet where I need to copy multiple cells every other column
and applicable to other worksheets. Under Set wks = Worksheets("mardet")
I need to put 12 worksheet names (febdet, mardet, aprdet) for the 12 months
of the year. Under Set myRng = .Range("c6:e20,g6:i20") I need to run this
loop 25 times for as to read 3 columns(c thru e), skip one column (f) and do
3 columns (g - i) and skip a column (j) and so on. The code that I use for a
worksheet is below. Your asistance is greatly appreciated

Option Explicit
Sub testme01()

Dim GrpBox As GroupBox
Dim OptBtn As OptionButton
Dim wks As Worksheet
Dim myCell As Range
Dim myRng As Range

Set wks = Worksheets("mardet")

With wks
'nice for testing
.OptionButtons.Delete
.GroupBoxes.Delete

Set myRng = .Range("c6:e20,g6:i20")
For Each myCell In myRng.Cells
With myCell
Set GrpBox = .Parent.GroupBoxes.Add(Top:=.Top, _
Left:=.Left, _
Width:=.Width, _
Height:=.Height)
GrpBox.Caption = ""
GrpBox.Visible = False

Set OptBtn = .Parent.OptionButtons.Add(Top:=.Top, _
Left:=.Left, _
Width:=.Width / 2, _
Height:=.Height)
OptBtn.Caption = ""
OptBtn.LinkedCell = .Address(external:=True)

Set OptBtn = .Parent.OptionButtons.Add(Top:=.Top, _
Left:=.Left + (.Width / 2), _
Width:=.Width / 2, _
Height:=.Height)
OptBtn.Caption = ""

.NumberFormat = ";;;"

End With
Next myCell
End With
End Sub
Sub compliance()

End Sub


--

Dave Peterson


All times are GMT +1. The time now is 06:13 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com