How To Automate Copy Certian Cells from Worksheet A to Certian Cells Worksheet B?

[Clarence Jackson]

I am currently not to experienced with VBA and have been trying to find Out
how to Automate Copying One Database to another

Currently I have a user database which is in Populate Database.xls I
currently Want to transfer the user information to the Another Options.xls
database
Now here are my current issues I want to basically convert this Big database
Populate Database.xls which contains specific user information for each
person on each row example
Range A1-A10 contain user information for bob
Range B1-B10 Contain user information for Susan
and so on for 100+ users
Furthermore I currently have to Archive each individual user in a pre
designed template with a worksheet for each individual user which is in
Another option.xls


I would currently like the code to be able to based on my first cell
selection to copy the information to the new workbook , Allow me to
elaborate to define exactly what I mean in this case


Example- I will select range ("b1") in workbook Populate Database.xls
and I will Run *this macro*
the macro will then know to copy the ranges of B1-B10 to the predefined
ranges in the workbook Another Option.xls this completes the macro
operations

ok now I select range("c1") in workbook Populate Database.xls and I will run
*this macro*
the macro will then know to copy the ranges of C1-C10 to the predefined
ranges in the workbook Another Option.xls this completes the macro




this is currently How far I got with the Code I think I did it Wrong your
Feedback would be Much appreciated




Sub AutomateChangeDirect()

Range("B15").Select
Selection.Copy
Windows("Another Option.xls").Activate
Range("B4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
Range("C15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
Range("B5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
Range("G15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
ActiveWindow.SmallScroll Down:=26
Range("D30").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Range("H15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 20
Range("D22").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
Range("I15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
Range("D24").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Range("J15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
ActiveWindow.SmallScroll Down:=4
Range("D25").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
Range("B11").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
Range("K15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
ActiveWindow.SmallScroll Down:=17
Range("D28").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Range("M15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
Range("D29").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Range("O15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
ActiveWindow.SmallScroll Down:=-1
Range("D26").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
ActiveWindow.LargeScroll Down:=1
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 10
ActiveWindow.SmallScroll ToRight:=2
Range("P15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
ActiveWindow.SmallScroll Down:=-11
Windows("Populate Database.xls").Activate
Windows("Another Option.xls").Activate
Range("D17").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
Range("Q15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
Range("D19").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Range("R15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
Windows("Populate Database.xls").Activate
Windows("Another Option.xls").Activate
Range("D20").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Windows("Populate Database.xls").Activate
ActiveWindow.SmallScroll ToRight:=2
Windows("Another Option.xls").Activate
Windows("Populate Database.xls").Activate
Range("S15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Another Option.xls").Activate
ActiveWindow.SmallScroll Down:=4
Range("D21").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False

End Sub

 

[JLGWhiz]

Clarence, I did not build a model for this to test it, so you
will have to test it on a copy of your files. If it does not run
OK then post back with what problems come up. Watch the
word wrap when you copy this over to your code module. You
might have to move some code up to the correct line.

Sub cpyrng()
lc1 = WorkBooks("Populate Database.xls").Worksheets(1).Cells(1,
Columns.Count).End(xlToLeft).Column
Wk1 = Workbooks("Populate Database.xls").Worksheets(1)
Wk2 = Workbooks("Another Option.xls").Worksheets(1)
Counter = 1
Do
lc2 = Workbooks("Another Option.xls").Worksheets(1).Cells(1,
Columns.Count).End(xlToLeft).Column
If Wk1.Cells(1, Counter) <> "" Then
Wk1.Range(Cells(1, Counter), Cells(10, Counter)).Copy Wk2.Range(Cells(1,
lc2 + 1))
Counter = Counter + 1
End If
Loop Until Counter = lc1 + 1
End Sub