PDA

View Full Version : Macro Loop to Copy/Paste picture and set of columns if Checkbox



Gibbons1984
11-08-2015, 07:40 PM
Hello!

I am having trouble with a macro of mine. I'm trying to create a wireframe creation form which copies a picture and the ranges next to it from Sheet2 and pastes both to Sheet1 if the check box next to it is checked. It needs to loop through the check boxes so that if one is not checked, it will go to the next checked box and copy the image and range directly under the last one on Sheet1.

I'm have little experience in VBA so please don't judge me on my code. Any and all help is appreciated.



Sub CheckboxLoop()
Dim PicRange1 As Range
Dim PicRange2 As Range
Dim PicRange3 As Range


Dim TextRangeA1 As Range
Dim TextRangeA2 As Range
Dim TextRangeA3 As Range


Dim TextRangeB1 As Range
Dim TextRangeB2 As Range
Dim TextRangeB3 As Range


PictRangeA1 = Worksheets("Sheet1").Range("C5")
PictRangeA2 = Worksheets("Sheet1").Range("C13")
PictRangeA3 = Worksheets("Sheet1").Range("C23")


TextRangeA1 = Worksheets("Sheet2").Range("O5:Y10")
TextRangeA2 = Worksheets("Sheet2").Range("O13:Y21")
TextRangeA3 = Worksheets("Sheet2").Range("O23:Y31")


TextRangeB1 = Worksheets("Sheet1").Range("O5:Y10")
TextRangeB2 = Worksheets("Sheet1").Range("O13:Y21")
TextRangeB3 = Worksheets("Sheet1").Range("O23:Y31")


For i = 2 To 4
If Worksheets("ActiveX").Controls("Checkbox" & i).Value = True Then
For j = 1 To 3
Worksheets("Sheet2").Shapes("Picture" & i).Copy
Worksheets("Sheet1").Range("PictRangeA" & i).Paste
Worksheets("Sheet1").Range("PictRangeA" & j).Copy
Worksheets("Sheet1").Range("PictRangeB" & j).Paste
Next j
End If
Next i


End Sub