Looping through a range and adding data from one worksheet to another but missing a column

[stirlingmw1]

Afternoon all

I have a workbook that I import data as a worksheet "ImportData" and that then adds this data from "ImportData" to the worksheet "Main" for manipulation. I am using the following code to copy data from the first 3 columns of importdata to main that populates from row 4 until all data rows are filled.

Sub AddDataToMain()

Dim ImpLRow As Long, MLRow
Dim wsI As Worksheet, wsM As Worksheet

Set wsM = Worksheets("Main")
Set wsI = Worksheets("ImportData")

'Adds NSN ADAC and Description to Main page
ImpLRow = wsI.cells(Rows.Count, 1).End(xlUp).Row
MLRow = wsM.cells(Rows.Count, 1).End(xlUp).Row

wsM.Range("A4:C" & ImpLRow).Value = wsI.Range("A4:C" & ImpLRow).Value

End Sub

What I am now trying to do is copy the remaining data from "ImportData" row 4 to lastrow Columns D to AC to "Main" row 4 Column F to BD but this time when data is copied from column D from the "ImportData" sheet it will be copied to the "Main" worksheet column F, then from ImportData column E to Main Column H so in effect leaving a blank column between the each column of copied data.

I hope I have explained that correctly and you can help.

regards

Steve

 

[Fluff]

How many rows of data are you likely to have on the importdata sheet?

 

[stirlingmw1]

How many rows of data are you likely to have on the importdata sheet?

Fluff

Thanks for getting back to me, currently there are 24 rows with the top 4 being headers, so 20 rows of importable data.

Regards

Steve

 

[Fluff]

Ok, how about

Sub stirlingmw()

Dim ImpLRow As Long, MLRow As Long, i As Long
Dim wsI As Worksheet, wsM As Worksheet
Dim Ary As Variant

Set wsM = Worksheets("Main")
Set wsI = Worksheets("ImportData")

'Adds NSN ADAC and Description to Main page
ImpLRow = wsI.Cells(Rows.Count, 1).End(xlUp).Row
MLRow = wsM.Cells(Rows.Count, 1).End(xlUp).Row
Ary = wsI.Range("A4:AC" & ImpLRow).Value2

wsM.Range("A4:C" & ImpLRow).Value = Application.Index(Ary, Evaluate("row(1:" & ImpLRow - 3 & ")"), Array(1, 2, 3))
For i = 4 To UBound(Ary, 2)
   wsM.Range("E4:E" & ImpLRow).Offset(, (i - 3) * 2 - 1).Value = Application.Index(Ary, , i)
Next i
End Sub

 

[stirlingmw1]

Ok, how about

Sub stirlingmw()

Dim ImpLRow As Long, MLRow As Long, i As Long
Dim wsI As Worksheet, wsM As Worksheet
Dim Ary As Variant

Set wsM = Worksheets("Main")
Set wsI = Worksheets("ImportData")

'Adds NSN ADAC and Description to Main page
ImpLRow = wsI.Cells(Rows.Count, 1).End(xlUp).Row
MLRow = wsM.Cells(Rows.Count, 1).End(xlUp).Row
Ary = wsI.Range("A4:AC" & ImpLRow).Value2

wsM.Range("A4:C" & ImpLRow).Value = Application.Index(Ary, Evaluate("row(1:" & ImpLRow - 3 & ")"), Array(1, 2, 3))
For i = 4 To UBound(Ary, 2)
   wsM.Range("E4:E" & ImpLRow).Offset(, (i - 3) * 2 - 1).Value = Application.Index(Ary, , i)
Next i
End Sub

Fluff

Fantastic, works a treat. Thank you

 

[Fluff]

You're welcome & thanks for the feedback.