View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
John John is offline
external usenet poster
 
Posts: 2,069
Default Help with condensing a lot of copying/pasting...

(col - 1) value is used to select the correct element of the Array which
starts at 0.

I am about to leave my office but as a quick suggestion try adding

AppendWS.Activate

above the second FOR Loop.

You should not really need to do this but have not got time to figure out
what error I have made.
--
jb


"gab1972" wrote:

On Jul 15, 10:14 am, john wrote:
You could use a loop to cycle through the ranges to reduce amount of code..

I had a quick play with following but not fully tested & approach could be
improved with more time. Hopefully though, will give you some ideas.

Sub CopyData()
Dim AppPerWS As Worksheet
Dim AppendWS As Worksheet
Dim PasteRange

Set AppPerWS = Worksheets("AppendPermit")
Set AppendWS = Worksheets("Appending")

PasteRange = Array("AN2", "AR2", "AV2", "AZ2", _
"BD2", "BH2", "BL2", "BP2", "BT2", "BX2", _
"CB2", "CF2", "CJ2", "CN2", "CR2", "CV2", "CZ2", _
"DD2", "DH2", "DL2", "DP2", "DT2", "DX2", _
"EB2", "EF2")

'Permit.Lifecycle information

Application.ScreenUpdating = False

On Error Resume Next

i = 5
For col = 1 To 7 Step 2

AppPerWS.Range(Cells(30, col), Cells(54, col)).Copy
AppendWS.Range("A" & i).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
Application.CutCopyMode = False

i = i + 1

Next col

For col = 1 To 25

AppendWS.Range(Cells(5, col), Cells(8, col)).Copy
AppendWS.Range(PasteRange(col - 1)).PasteSpecial
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True

Application.CutCopyMode = False

Next col

Application.ScreenUpdating = True
End Sub

--
jb



"gab1972" wrote:
I'm working on a spreadsheet that requires pulling information from
one sheet (that is an input form for users) and then puts all the
information on one line for transfer to MS Access. I have about 24
rows of info in columns A, C, E, G. I need to get that information
into one row. Below is the only way I know how. Can anyone help me
condense this to something simpler? Thanks in advance.


'Permit.Lifecycle information
Sheets("AppendPermit").Range("A30:A54").Copy
Sheets("Appending").Range("A5").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("AppendPermit").Range("C30:C54").Copy
Sheets("Appending").Range("A6").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("AppendPermit").Range("E30:E54").Copy
Sheets("Appending").Range("A7").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("AppendPermit").Range("G30:G54").Copy
Sheets("Appending").Range("A8").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("A5:A8").Copy
Sheets("Appending").Range("AN2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("B5:B8").Copy
Sheets("Appending").Range("AR2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("C5:C8").Copy
Sheets("Appending").Range("AV2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("D5:E8").Copy
Sheets("Appending").Range("AZ2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("E5:E8").Copy
Sheets("Appending").Range("BD2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("F5:G8").Copy
Sheets("Appending").Range("BH2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("G5:H8").Copy
Sheets("Appending").Range("BL2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("H5:H8").Copy
Sheets("Appending").Range("BP2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("I5:I8").Copy
Sheets("Appending").Range("BT2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("J5:J8").Copy
Sheets("Appending").Range("BX2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("K5:K8").Copy
Sheets("Appending").Range("CB2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("L5:L8").Copy
Sheets("Appending").Range("CF2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("M5:M8").Copy
Sheets("Appending").Range("CJ2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("N5:N8").Copy
Sheets("Appending").Range("CN2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("O5:O8").Copy
Sheets("Appending").Range("CR2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("P5:P8").Copy
Sheets("Appending").Range("CV2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("Q5:Q8").Copy
Sheets("Appending").Range("CZ2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("R5:R8").Copy
Sheets("Appending").Range("DD2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("S5:S8").Copy
Sheets("Appending").Range("DH2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("T5:T8").Copy
Sheets("Appending").Range("DL2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("U5:U8").Copy
Sheets("Appending").Range("DP2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("V5:V8").Copy
Sheets("Appending").Range("DT2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("W5:W8").Copy
Sheets("Appending").Range("DX2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("X5:X8").Copy
Sheets("Appending").Range("EB2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Appending").Range("Y5:Y8").Copy
Sheets("Appending").Range("EF2").PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True


Out of curiosity...what is the (col - 1) portion for? I used this in
a sample/testing sheet and it doesn't paste the first set (i.e. A5:A8)