Clear cells from ith row - excel

Question

I have the code below but once its executed I need to clear all Columns from A to G from the ith row
Sub GetPic()
Dim fNameAndPath As String
Dim img As Object
Dim CommodityName1 As String, T1 As String
Dim myDir As String
Dim i As Integer, j As Integer
Worksheets("Picture").Activate
Dim shape As Excel.shape
Dim datarangeb As Range
Dim numberofcells As Integer
Set datarangeb = Sheets("Data").Range("b:b")
numberofcells = WorksheetFunction.CountA(datarangeb)
numberofcells = numberofcells * 12 + 1
For Each shape In ActiveSheet.Shapes
shape.Delete
Next
j = 7
For i = 2 To numberofcells
myDir = "C:\Users\User\Desktop\ESTIMATING SHEETS\test\rebar shapes" & "\"
CommodityName1 = Range("a" & i)
T1 = ".png"
fNameAndPath = myDir & CommodityName1 & T1
On Error GoTo errormessage:
Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
On Error GoTo errormessage:
With img
'Move and Resize Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("d" & i).Left
.Top = ActiveSheet.Range("d" & i).Top
.Width = ActiveSheet.Range("d" & i & ":g" & i).Width
.Height = ActiveSheet.Range("d" & i & ":g" & j).Height
errormessage:
If Err.Number = 1004 Then
Exit Sub
MsgBox "File does not exist." & vbCrLf & "Check the name of the rebar!"
End If
End With
Application.ScreenUpdating = True
i = i + 11
j = j + 12
Next i
i = i - 1
End Sub
So Im not too sure what the syntax is to clear up to the end of column G. One way is to just clear it up to G6000 or some large number but I want the code to execute not using too much memory

Answer 1

Sub schedulemacro()
Dim k As Integer
Dim data As Worksheet, Picture As Worksheet, sheet1 As Worksheet
Dim i As Integer, j As Integer
Set data = Sheets("Data")
Set Picture = Sheets("Picture")
Set sheet1 = Sheets("Sheet 1")
j = 13
Picture.Activate
data.Cells(2, 2) = sheet1.Cells(2, 1)
k = WorksheetFunction.CountA(sheet1.Range("b:b")) - 1
sheet1.Range("a2:k" & k + 1).copy
data.Range("b2:k" & k + 1).PasteSpecial xlPasteValues
If k = 0 Then
MsgBox ("Please place data into the data sheet or export from revit!")
data.Activate
data.Range("a2:l2").Select
Exit Sub
End If
Picture.Range("A1:G12").Select
Selection.copy
For i = 1 To k
data.Range("a" & i + 1) = i
Picture.Range("a" & j).PasteSpecial
j = j + 12
Next i
j = 1
i = 2
k = k + 1
For i = 2 To k
Picture.Cells(j, 1) = data.Range("A" & i)
j = j + 12
Next i
Call GetPic
End Sub
Sub GetPic()
Dim fNameAndPath As String
Dim img As Object
Dim CommodityName1 As String, T1 As String
Dim myDir As String
Dim i As Integer, j As Integer
Worksheets("Picture").Activate
Dim shape As Excel.shape
Dim datarangeb As Range
Dim numberofcells As Integer
Set datarangeb = Sheets("Data").Range("b:b")
numberofcells = WorksheetFunction.CountA(datarangeb)
numberofcells = (numberofcells - 1) * 12 + 1
For Each shape In ActiveSheet.Shapes
shape.Delete
Next
j = 7
For i = 2 To numberofcells
myDir = "C:\Users\User\Desktop\ESTIMATING SHEETS\test\rebar shapes" & "\"
CommodityName1 = Range("a" & i)
T1 = ".png"
fNameAndPath = myDir & CommodityName1 & T1
On Error GoTo errormessage:
Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
On Error GoTo errormessage:
With img
'Move and Resize Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveSheet.Range("d" & i).Left
.Top = ActiveSheet.Range("d" & i).Top
.Width = ActiveSheet.Range("d" & i & ":g" & i).Width
.Height = ActiveSheet.Range("d" & i & ":g" & j).Height
errormessage:
If Err.Number = 1004 Then
Exit Sub
MsgBox "File does not exist." & vbCrLf & "Check the name of the rebar!"
End If
End With
Application.ScreenUpdating = True
i = i + 11
j = j + 12
Next i
i = i - 1
Worksheets("Picture").Range("A" & i & ":i27000").Clear
End Sub