VBA: multiple copy and paste from one sheet to another

Question

I'm new with vba and have created a macro that copy columns from all worksheets (sourceSheet) in the workbook over to Sheet1 (destSheet) and also creating an header in Sheet1 (destSheet).

It's working fine when I'm running it with columns in order, like A to D (A:D) but I want to copy the columns

A from sourceSheet to B in destSheet
B from sourceSheet to C in destSheet
C from sourceSheet to D in destSheet
D from sourceSheet to E in destSheet
E from sourceSheet to G in destSheet
J from sourceSheet to H in destSheet
K from sourceSheet to I in destSheet
O from sourceSheet to J in destSheet
I also want to insert a blank row in F in destSheet.

Someone that can help me with this ?

Sub Test()
Dim sourceSheet As Worksheet 'Define Source Sheet
Dim sourceRows As Integer 'Define Source Row
Dim destSheet As Worksheet 'Define Destination Sheet
Dim lastRow As Integer 'Define Last Row
Dim sourceMaxRows As Integer 'Define Source Max Rows
Dim totalRows As Integer 'Define Total Rows
Dim destRange As String 'Define Destination Range
Dim sourceRange As String 'Define Source Range

lastRow = 1

Worksheets.Add().Name = "Sheet1"

For Each sourceSheet In Worksheets

If sourceSheet.Name <> "Sheet1" Then

    sourceSheet.Activate
    sourceMaxRows = sourceSheet.Cells(Rows.Count, "A").End(xlUp).Row
    totalRows = lastRow + sourceMaxRows - 4

    Let sourceRange = "A5:D" & sourceMaxRows
    Range(sourceRange).Select
    Selection.Copy
    sourceSheet.Select

    Set destSheet = Worksheets("Sheet1")
    destSheet.Activate
    Let destRange = "B" & lastRow & ":E" & totalRows
    Range(destRange).Select
    destSheet.Paste
    destSheet.Select

    lastRow = lastRow + sourceMaxRows - 4
    End If
Next

Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Product_Id"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Category"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Brand"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Model"
Range("E1").Select
ActiveCell.FormulaR1C1 = "EAN"
Range("F1").Select
ActiveCell.FormulaR1C1 = "UPC"
Range("G1").Select
ActiveCell.FormulaR1C1 = "SKU"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Supplier_Shop_Price"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Invoice_Price"
Range("J1").Select
ActiveCell.FormulaR1C1 = "In_Stock"
Range("A1").Select

MsgBox "Updated"
End Sub

Matteo NNZ Matteo NNZ · Accepted Answer · 2015-01-22T21:38:28

You need to build-up an algorithm on the following logic: for each sheet you run, the source column is "1" and the destination column is "2": at the end of each loop, you need to increment both variables by 2. Here is how your code algorithm should look like (I let you do the job of rearranging your specific code to the algorithm):

sourceColumnIndex = 1
destColumnIndex = 2
sourceColumn = Split(Cells(1, sourceColumnIndex).Address, "$")(1)
destColumn = Split(Cells(1, destColumnIndex).Address, "$")(1)

For Each sourceSheet In Worksheets
 'do your job here: for example: 
 '...
 sourceMaxRows = sourceSheet.Cells(Rows.Count, sourceColumn).End(xlUp).Row
 '...
 destRange = destColumn & lastRow & ":E" & totalRows
 '...

 'before to go to the next, readapt the indexes:
 sourceColumnIndex = sourceColumnIndex + 2
 destColumnIndex = destColumnIndex + 2
 sourceColumn = Split(Cells(1, sourceColumnIndex).Address, "$")(1)
 destColumn = Split(Cells(1, destColumnIndex).Address, "$")(1)

 'we can go to the next with "C" and "D", then with "E" and "F" etc. 
Next sourceSheet

NOTE 1

Such a function:

sourceColumn = Split(Cells(1, sourceColumnIndex).Address, "$")(1)

is just converting the column number to the associated letter by using the address and splitting it by "$".

NOTE 2

A passage like this is useless as well as slower:

Range("A1").Select
ActiveCell.FormulaR1C1 = "Product_Id"

Rather, try to re-factor your code like this:

Range("A1").FormulaR1C1 = "Product_Id"

without need of selecting the cell, but directly writing on its property (in this case I would rather use .Value, but you might want to use .FormulaR1C1, you know better than me.

AFTER THAT CHRISTMAS007 HAS CLEANED YOUR QUESTION

Well, clearly the key of all this is to use a variable letter. I might suggest you to embed the split into a function that converts numbers in letters:

Function myColumn(ByVal num As Integer) As String
    myColumn = Split(Cells(1, num).Address, "$")(1)
End Function

and every time working with numbers. You can call the above function like this:

num = 1
Range(myColumn(num) & 1).Select

the above will select for you the range "A1", because you passed the number "1" into the function. Of course, being your request a bit more detailed, this is something you should study yourself. But the idea is anyway that one: define the indexes at the beginning, such as indSource and indDest, then...

decrease them at your pleasure with indSource = indSource - 1 (or -2, or -3) increase them at your pleasure with indDest = indDest + 1 (or +2, or +3)

and work within the loop to get your desired results.

VBA: multiple copy and paste from one sheet to another

2 Answers