Excel/vba code

[mkostas66]

Hi!

I have the following code. It supposed to copy certain cells to a new book.
If i run the code in VBA with F5 it's working but when i hit the button with the code in the excel i get 0 copies.

Any ideas what's wrong?

Sub UpdateActionPlan()

Dim intAdded As Integer, intSRow, intTRow
Dim sngRecord(6)
Dim strTFullPath As String
Dim strText As String
Dim strResponse As VbMsgBoxResult
Dim cancel As Integer
Dim strFileName As String
Dim i As Integer
Dim LastRow As Integer
Dim FirstRow As Integer

FirstRow = 7
LastRow = 1000
i = FirstRow


strFileName = “Test.xls”
strTFullPath = strFileName
Workbooks.Open filename:=strTFullPath

Do Until i > LastRow
If Range("I" & i).Value = "Action" Then
 sngRecord(0) = Range("C" & i).Value
 sngRecord(1) = Range("G" & i).Value
 sngRecord(2) = Range("N" & i).Value
 sngRecord(3) = Range("O" & i).Value
 sngRecord(4) = Range("P" & i).Value
 sngRecord(5) = Range("T6").Value

 With Workbooks("Test.xlsx").Worksheets("CheckSheet")
       intTRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      .Range("C" & intTRow) = sngRecord(0)
      .Range("E" & intTRow) = sngRecord(1)
      .Range("G" & intTRow) = sngRecord(2)
      .Range("A" & intTRow) = sngRecord(3)
      .Range("D" & intTRow) = sngRecord(4)
     .Range("B" & intTRow) = sngRecord(5)
 End With
Else
 Cancel = True
End If

i = i + 1
Loop

End Sub

 

[mkostas66]

Ignore data in column R please.

Code:

Option Explicit

Sub Button36_Click()
Dim intTRow As Long
Dim strFileName As String
Dim i As Integer
Dim ValOfT6 As Variant 'The value of cell T6, change to a better name

strFileName = "Test.xlsx"
Workbooks.Open filename:=strFileName
ValOfT6 = Range("T6").Value
For i = 7 To 1000
If Range("S" & i).Value = "Action" Then
With Workbooks("Test.xlsm").Worksheets("Checksheet")
intTRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Range("C" & intTRow) = Range("C" & i).Value
.Range("E" & intTRow) = Range("G" & i).Value
.Range("G" & intTRow) = Range("N" & i).Value
.Range("A" & intTRow) = Range("O" & i).Value
.Range("D" & intTRow) = Range("P" & i).Value
.Range("B" & intTRow) = ValOfT6
End With
End If
Next i
End Sub