Copy marked records from Workbook to Workbook

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Am using the following code (amended to suit my need)
by gwengrofsky in this ng. Requesting help to modify code so
that (1) read data starts at B2 or other row (instead of col A)
and write starts at B2 (instead of col A) (2) target sheet not be
cleared before each execution but records be added in
sequence (3) Source workbook will vary always therefore
have to refer as ActiveWorkbook. Have seen Ron’s
codes but unable to fix (no VBA knowledge).

Thank you in advance for those trying.

Sub RtoUCopy()
Dim Var1 As Variant
Dim Var2 As Variant
Dim Var3 As Variant
Dim Var4 As Variant
Dim Var5 As Variant
Dim Var6 As Variant
Dim Var7 As Variant
Dim Var8 As Variant
Dim Var9 As Variant
Dim Var10 As Variant
Dim Var11 As Variant
Dim Var12 As Variant
Dim Var13 As Variant
Dim Var14 As Variant
Dim Var15 As Variant
Dim Var16 As Variant
Dim Var17 As Variant
Dim Var18 As Variant
Dim Var19 As Variant
Dim Var20 As Variant
Dim Var21 As Variant
Dim Var22 As Variant
Dim Var23 As Variant
Dim Var24 As Variant
Dim Var25 As Variant
Dim Var26 As Variant

Dim RowR As Integer
Dim RowU As Integer

' Both workbooks need to be open first. Cell A2 must be st'art
'of data.
RowR = 2
RowU = 2
Application.Workbooks("Register.xls").Worksheets(1).Activate
Do While Not IsEmpty(Cells(RowR, 1))
Var24 = Cells(RowR, 24)
If LCase(Var24) = "out" Then
Var1 = Cells(RowR, 1)
Var2 = Cells(RowR, 2)
Var3 = Cells(RowR, 3)
Var4 = Cells(RowR, 4)
Var6 = Cells(RowR, 6)
Var8 = Cells(RowR, 8)
Var9 = Cells(RowR, 9)
Var10 = Cells(RowR, 10)
Var11 = Cells(RowR, 11)
Var12 = Cells(RowR, 12)
Var15 = Cells(RowR, 15)
Var16 = Cells(RowR, 16)
Var17 = Cells(RowR, 17)


Application.Workbooks("Update.xls").Worksheets(1).Activate
Cells(RowU, 1) = Var1
Cells(RowU, 2) = Var2
Cells(RowU, 3) = Var3
Cells(RowU, 4) = Var4
Cells(RowU, 5) = Var6
Cells(RowU, 6) = Var8
Cells(RowU, 7) = Var9
Cells(RowU, 8) = Var10
Cells(RowU, 9) = Var11
Cells(RowU, 10) = Var15
Cells(RowU, 11) = Var16
Cells(RowU, 12) = Var17
Cells(RowU, 13) = Var24

RowU = RowU + 1

Application.Workbooks("Register.xls").Worksheets(1).Activate
End If
RowR = RowR + 1
Loop
End Sub
 
Sub RtoUCopy()
Dim Var1 As Variant
Dim Var2 As Variant
Dim Var3 As Variant
Dim Var4 As Variant
Dim Var5 As Variant
Dim Var6 As Variant
Dim Var7 As Variant
Dim Var8 As Variant
Dim Var9 As Variant
Dim Var10 As Variant
Dim Var11 As Variant
Dim Var12 As Variant
Dim Var13 As Variant
Dim Var14 As Variant
Dim Var15 As Variant
Dim Var16 As Variant
Dim Var17 As Variant
Dim Var18 As Variant
Dim Var19 As Variant
Dim Var20 As Variant
Dim Var21 As Variant
Dim Var22 As Variant
Dim Var23 As Variant
Dim Var24 As Variant
Dim Var25 As Variant
Dim Var26 As Variant
Dim i as Long
Dim RowR As Integer
Dim RowU As Integer

' Both workbooks need to be open first. Cell A2 must be st'art
'of data.
RowR = 2
RowU =Workbooks("Update.xls").Worksheets(1) _
.Cells(rows.count,2).End(xlup).row + 1
Application.Workbooks("Register.xls").Worksheets(1).Activate
Do While Not IsEmpty(Cells(RowR, "B"))
Var24 = Cells(RowR, 24)
If LCase(Var24) = "out" Then
Var1 = Cells(RowR, 1)
Var2 = Cells(RowR, 2)
Var3 = Cells(RowR, 3)
Var4 = Cells(RowR, 4)
Var6 = Cells(RowR, 6)
Var8 = Cells(RowR, 8)
Var9 = Cells(RowR, 9)
Var10 = Cells(RowR, 10)
Var11 = Cells(RowR, 11)
Var12 = Cells(RowR, 12)
Var15 = Cells(RowR, 15)
Var16 = Cells(RowR, 16)
Var17 = Cells(RowR, 17)


Application.Workbooks("Update.xls").Worksheets(1).Activate
i = 2 ' column B
Cells(RowU, i) = Var1
Cells(RowU, i+1) = Var2
Cells(RowU, i+2) = Var3
Cells(RowU, i+3) = Var4
Cells(RowU, i+4) = Var6
Cells(RowU, i+5) = Var8
Cells(RowU, i+6) = Var9
Cells(RowU, i+7) = Var10
Cells(RowU, i+8) = Var11
Cells(RowU, i+9) = Var15
Cells(RowU, i+10) = Var16
Cells(RowU, i+11) = Var17
Cells(RowU, i+12) = Var24

RowU = RowU + 1

Application.Workbooks("Register.xls").Worksheets(1).Activate
End If
RowR = RowR + 1
Loop
End Sub
 
Thank you Tom. I planted your code. Yes it reads from col b but writes to
col c
(instead col b). It does not do the rest. I shall figure it out over time.
You have put me in the right direction.
 
Let's try it in the immediate window and see:

rowU = 10
i = 2 ' column B
? Cells(RowU, i).address
$B$10

looks like column B to me. Maybe you didn't plant the code properly.
 
Tom, I saw your last post only just now. I had in the meantime thru trial and
error (taking about 3 hours) got the code working exactly as I wanted. Made
the followng
changes.

Do While Not IsEmpty(Cells(RowR, "D"))

Application.Workbooks("AUpate.xls").Worksheets(1).Activate
i = 1 ' column B
Cells(RowU, i) = Var1
Cells(RowU, i + 1) = Var2
Cells(RowU, i + 2) = Var3
Cells(RowU, i + 3) = Var4 'was 5 OK
Cells(RowU, i + 4) = Var6 'was 7 OK
Cells(RowU, i + 5) = Var8
Cells(RowU, i + 6) = Var9
Cells(RowU, i + 7) = Var10
Cells(RowU, i + 8) = Var11 'was 12 OK
Cells(RowU, i + 9) = Var12
Cells(RowU, i + 10) = Var15 'Was 14 OK
Cells(RowU, i + 11) = Var16 'Was 15 ok
Cells(RowU, i + 12) = Var17 'Was 16 ok
Cells(RowU, i + 13) = Var18 'Was 17 ok
Cells(RowU, i + 14) = Var24

As I said before, YOU put me on the right track. Tk u again.
 
Back
Top