Copy cells in Excel

  • Thread starter Thread starter DeDan Austin
  • Start date Start date
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
 
NOT tested. Try and modify if necessary

Sub CombineFilesSAS()
Set ds = ActiveWorkbook
Workbooks.Open Filename:= _
"C:\Users\2hot4u\Desktop\Painting Estimate.xlsx"
ActiveWorkbook.Sheets(1).UsedRange.Copy _
ds.Sheets("paintest").Range("a65536").End(xlUp).Offset(1)
ActiveWorkbook.Close
End Sub
 
Back
Top