D
DeDan Austin
I've been working on a code to copy cells from one excel file to
another excel file.
It seems to copy the cells but it's not indexing from the source file
through the next cells to copy.
It seems to never reach the last line of Next iSrow. It only goes to
Next iTrow until the end
over writing the cell it had previouly copied to the Target file. Any
help would be greatly
appreciated. I am only a beginner at this. Anyway here my code. What's
wrong with it?
Sub copydimensions()
Dim sSource As String, iWork As Long, sTarget As String
Dim iTrow As Long, iTcol As Long, iSrow As Long, iScol As Long
Dim iQuantity As Long, iWork2 As Long
'Workbooks.Open Filename:="C:\Users\2hot4u\Desktop\Painting
Estimate.xlsx"
sSource = "Dimensions.xlsm"
sTarget = "Painting Estimate.xlsx"
i = 0
iTrow = 0
iSrow = 0
iTcol = 0
For iSrow = 3 To 32000
If Trim$(Workbooks(sSource).Worksheets(1).Cells(iSrow, 1)) =
"" Then Exit For
iWork2 = Val(Workbooks(sSource).Worksheets(1).Cells(iSrow, 1))
For iTrow = 12 To 32000
If Trim$
(Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 1)) = "" Then
Exit For
iWork =
Val(Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 1))
If iWork <> iWork2 Then
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 2)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 1)
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 4)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 2)
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 10)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 3)
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 12)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 4)
End If
Next iTrow
Next iSrow
End Sub
another excel file.
It seems to copy the cells but it's not indexing from the source file
through the next cells to copy.
It seems to never reach the last line of Next iSrow. It only goes to
Next iTrow until the end
over writing the cell it had previouly copied to the Target file. Any
help would be greatly
appreciated. I am only a beginner at this. Anyway here my code. What's
wrong with it?
Sub copydimensions()
Dim sSource As String, iWork As Long, sTarget As String
Dim iTrow As Long, iTcol As Long, iSrow As Long, iScol As Long
Dim iQuantity As Long, iWork2 As Long
'Workbooks.Open Filename:="C:\Users\2hot4u\Desktop\Painting
Estimate.xlsx"
sSource = "Dimensions.xlsm"
sTarget = "Painting Estimate.xlsx"
i = 0
iTrow = 0
iSrow = 0
iTcol = 0
For iSrow = 3 To 32000
If Trim$(Workbooks(sSource).Worksheets(1).Cells(iSrow, 1)) =
"" Then Exit For
iWork2 = Val(Workbooks(sSource).Worksheets(1).Cells(iSrow, 1))
For iTrow = 12 To 32000
If Trim$
(Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 1)) = "" Then
Exit For
iWork =
Val(Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 1))
If iWork <> iWork2 Then
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 2)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 1)
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 4)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 2)
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 10)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 3)
Workbooks(sTarget).Worksheets("Paintest").Cells(iTrow, 12)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 4)
End If
Next iTrow
Next iSrow
End Sub