ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   Copy cells in Excel (https://www.excelbanter.com/excel-worksheet-functions/270940-copy-cells-excel.html)

DeDan Austin

Copy cells in Excel
 
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(i Trow, 1)) = "" Then
Exit For


iWork =
Val(Workbooks(sTarget).Worksheets("Paintest").Cell s(iTrow, 1))

If iWork < iWork2 Then
Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 2)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 1)
Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 4)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 2)
Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 10)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 3)
Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 12)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 4)
End If

Next iTrow
Next iSrow

End Sub



Don Guillett[_2_]

Copy cells in Excel
 

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).Of fset(1)
ActiveWorkbook.Close
End Sub



On Nov 5, 9:48*pm, DeDan Austin wrote:
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(i Trow, 1)) = "" Then
Exit For

* * * * * * iWork =
Val(Workbooks(sTarget).Worksheets("Paintest").Cell s(iTrow, 1))

* * * * If iWork < iWork2 Then
* * * * * * Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 2)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 1)
* * * * * * Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 4)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 2)
* * * * * * Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 10)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 3)
* * * * * * Workbooks(sTarget).Worksheets("Paintest").Cells(iT row, 12)
= Workbooks(sSource).Worksheets(1).Cells(iSrow, 4)
* * * * End If

* * Next iTrow
* * * * Next iSrow

End Sub




All times are GMT +1. The time now is 05:04 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com