Copy Across worksheets

[Larry]

The following is part of code to copy cells from one worksheet to another
worksheet. Is there a way to rebuild the routine to take less coding and
better work response to prevent worksheet shimmers. A very special thanks for
anyone who can help me.

Set aSourceRange = Sheets("invDataFile").Range("A1:B1")
Set aDestRange = Sheets("invDatabase").Range("A" & Lr)
Set jSourceRange = Sheets("invDataFile").Range("B1")
Set jDestRange = Sheets("invDatabase").Range("B" & Lr)
Set bSourceRange = Sheets("Inventory").Range("AB9")
Set bDestRange = Sheets("invDatabase").Range("C" & Lr)
Set cSourceRange = Sheets("invDataFile").Range("D1:E1")
Set cDestRange = Sheets("invDatabase").Range("D" & Lr)
Set kSourceRange = Sheets("invDataFile").Range("E1")
Set kDestRange = Sheets("invDatabase").Range("E" & Lr)
Set dSourceRange = Sheets("Inventory").Range("AA11")
Set dDestRange = Sheets("invDatabase").Range("F" & Lr)
Set eSourceRange = Sheets("Inventory").Range("AG11")
Set eDestRange = Sheets("invDatabase").Range("G" & Lr)
Set fSourceRange = Sheets("Inventory").Range("AB13")
Set fDestRange = Sheets("invDatabase").Range("H" & Lr)
Set gSourceRange = Sheets("Inventory").Range("X19")
Set gDestRange = Sheets("invDatabase").Range("K" & Lr)
Set hSourceRange = Sheets("invDataFile").Range("L1")
Set hDestRange = Sheets("invDatabase").Range("L" & Lr)
Set iSourceRange = Sheets("Inventory").Range("AC15")
Set iDestRange = Sheets("invDatabase").Range("N" & Lr)

aSourceRange.Copy
aDestRange.PasteSpecial xlPasteValues, , False, False
bSourceRange.Copy
bDestRange.PasteSpecial xlPasteValues, , False, False
cSourceRange.Copy
cDestRange.PasteSpecial xlPasteValues, , False, False
dSourceRange.Copy
dDestRange.PasteSpecial xlPasteValues, , False, False
eSourceRange.Copy
eDestRange.PasteSpecial xlPasteValues, , False, False
fSourceRange.Copy
fDestRange.PasteSpecial xlPasteValues, , False, False
gSourceRange.Copy
gDestRange.PasteSpecial xlPasteValues, , False, False
hSourceRange.Copy
hDestRange.PasteSpecial xlPasteValues, , False, False
iSourceRange.Copy
iDestRange.PasteSpecial xlPasteValues, , False, False
--
Larry E. Brueshaber

[JMB]

Perhaps this will help some:

Sub test()
Dim Source1 As Worksheet
Dim Source2 As Worksheet
Dim Dest As Worksheet

Set Source1 = Sheets("invDataFile")
Set Source2 = Sheets("Inventory")
Set Dest = Sheets("invDatabase")

With Dest
.Range("A" & lr & ":B" & lr).Value = _
Source1.Range("A1:B1").Value
.Range("C" & lr).Value = Source2.Range("AB9").Value
.Range("D" & lr & ":E" & lr).Value = _
Source1.Range("D1:E1").Value
.Range("F" & lr).Value = Source2.Range("AA11").Value
.Range("G" & lr).Value = Source2.Range("AG11").Value
.Range("H" & lr).Value = Source2.Range("AB13").Value
.Range("K" & lr).Value = Source2.Range("X19").Value
.Range("L" & lr).Value = Source1.Range("L1").Value
.Range("N" & lr).Value = Source2.Range("AC15").Value
End With

End Sub


"Larry" wrote:

> The following is part of code to copy cells from one worksheet to another
> worksheet. Is there a way to rebuild the routine to take less coding and
> better work response to prevent worksheet shimmers. A very special thanks for
> anyone who can help me.
>
> Set aSourceRange = Sheets("invDataFile").Range("A1:B1")
> Set aDestRange = Sheets("invDatabase").Range("A" & Lr)
> Set jSourceRange = Sheets("invDataFile").Range("B1")
> Set jDestRange = Sheets("invDatabase").Range("B" & Lr)
> Set bSourceRange = Sheets("Inventory").Range("AB9")
> Set bDestRange = Sheets("invDatabase").Range("C" & Lr)
> Set cSourceRange = Sheets("invDataFile").Range("D1:E1")
> Set cDestRange = Sheets("invDatabase").Range("D" & Lr)
> Set kSourceRange = Sheets("invDataFile").Range("E1")
> Set kDestRange = Sheets("invDatabase").Range("E" & Lr)
> Set dSourceRange = Sheets("Inventory").Range("AA11")
> Set dDestRange = Sheets("invDatabase").Range("F" & Lr)
> Set eSourceRange = Sheets("Inventory").Range("AG11")
> Set eDestRange = Sheets("invDatabase").Range("G" & Lr)
> Set fSourceRange = Sheets("Inventory").Range("AB13")
> Set fDestRange = Sheets("invDatabase").Range("H" & Lr)
> Set gSourceRange = Sheets("Inventory").Range("X19")
> Set gDestRange = Sheets("invDatabase").Range("K" & Lr)
> Set hSourceRange = Sheets("invDataFile").Range("L1")
> Set hDestRange = Sheets("invDatabase").Range("L" & Lr)
> Set iSourceRange = Sheets("Inventory").Range("AC15")
> Set iDestRange = Sheets("invDatabase").Range("N" & Lr)
>
> aSourceRange.Copy
> aDestRange.PasteSpecial xlPasteValues, , False, False
> bSourceRange.Copy
> bDestRange.PasteSpecial xlPasteValues, , False, False
> cSourceRange.Copy
> cDestRange.PasteSpecial xlPasteValues, , False, False
> dSourceRange.Copy
> dDestRange.PasteSpecial xlPasteValues, , False, False
> eSourceRange.Copy
> eDestRange.PasteSpecial xlPasteValues, , False, False
> fSourceRange.Copy
> fDestRange.PasteSpecial xlPasteValues, , False, False
> gSourceRange.Copy
> gDestRange.PasteSpecial xlPasteValues, , False, False
> hSourceRange.Copy
> hDestRange.PasteSpecial xlPasteValues, , False, False
> iSourceRange.Copy
> iDestRange.PasteSpecial xlPasteValues, , False, False
> --
> Larry E. Brueshaber