make shorter code

elmnas · Sep 7, 2015

Hello people,

I have made a very long code....
But I want to make it shorter, but I don't know how...
I got thoughts about create a kind of an array/case/for loop instead,
have someone a suggestion how to make this code shorter?

Code:

Sub GetColData()
'This function Get all the column data from the "Company" sheet.
' If name "xxx" then copy following sheets to current workbook.
For Each sht In ThisWorkbook.Worksheets
    mysheetname = sht.Name
    
        If sht.Name Like "Volvo_3P*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If
        
        If sht.Name Like "Volvo_Penta*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If
        
        If sht.Name Like "Volvo_Bus*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If
        
        If sht.Name Like "Volvo_Business_Service*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If
        
        If sht.Name Like "Volvo_Group_Trucks_Technology*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If
        
        If sht.Name Like "Volvo_Information_Technology_AB*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If
        
         If sht.Name Like "Volvo_Group_Sweden*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If
        
        
        If sht.Name Like "Volvo_IT*" Then
        Sheets(mysheetname).Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("C:C").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("D:D").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("D:D").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("H:H").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("E:E").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("I:I").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("G:G").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("J:J").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("H:H").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("K:K").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("I:I").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("L:L").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("J:J").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("M:M").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("E:E").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("K:K").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("F:F").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("M:M").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("U:U").Select
        ActiveSheet.Paste
        
        Sheets(mysheetname).Select
        Columns("O:O").Select
        Selection.Copy
        Sheets("Target_sheet").Select
        Columns("AB:AB").Select
        ActiveSheet.Paste
        End If


    Next sht
End Sub

Thank you in advance

Arjan77 · Sep 7, 2015

There seems to be little relation between the source column and the destination column, this makes it almost impossible to append a loop. You could use names for your selections and order them in such a way that you address them with an integer in a loop, e.g. SourceColumn1 DestinationColumn1
Your code would become something like this:

Code:

for i = 1 to 20 ' or whatever number of columns you like to copy
Range("SourceColumn" & i).Copy
Range("DestinationColumn" & i).PasteSpecial
Next

ukmikeb · Sep 7, 2015

Hi

Something like this

Code:

Sub elmnas()
Dim InAry, OutAry
Dim Col, i
Dim mysheetname As String

InAry = Array(1, 3, 4, 5, 7)
OutAry = Array(1, 4, 8, 9, 10)

For Each sht In ThisWorkbook.Worksheets
    mysheetname = sht.Name
    
    If sht.Name Like "Volvo_3P*" Then
     For Col = 0 To UBound(InAry, 1)
     Sheets(mysheetname).Column(InAry(Col)).Copy Destination:=Sheets("Target_sheet").Column(OutAry(Col))
     Next Col
    End If
Next sht

End Sub

Specify the source columns in InAry and the destination Columns in OutAry.

You could also create a further array for the sheets you need to copy.

hth

Ps You do realise that some of the copies appear to be duplicated to the same destination columns!

elmnas · Sep 7, 2015

ukmikeb said:
Hi

Something like this

Code:

Sub elmnas() Dim InAry, OutAry Dim Col, i Dim mysheetname As String InAry = Array(1, 3, 4, 5, 7) OutAry = Array(1, 4, 8, 9, 10) For Each sht In ThisWorkbook.Worksheets mysheetname = sht.Name If sht.Name Like "Volvo_3P*" Then For Col = 0 To UBound(InAry, 1) Sheets(mysheetname).Column(InAry(Col)).Copy Destination:=Sheets("Target_sheet").Column(OutAry(Col)) Next Col End If Next sht End Sub

Specify the source columns in InAry and the destination Columns in OutAry.

You could also create a further array for the sheets you need to copy.

hth

Ps You do realise that some of the copies appear to be duplicated to the same destination columns!

I like the code but I get error in the line:
Sheets(mysheetname).Column(InAry(Col)).Copy Destination:=Sheets("Volvo_Statistik").Column(OutAry(Col))

runtime error 438'
the object does not support the properties or method

ukmikeb · Sep 7, 2015

Hi

You could split that line to :-

Code:

Sheets(mysheetname).Column(InAry(Col)).Copy 
Sheets("Volvo_Statistik").Column(OutAry(Col).Paste

hth

ukmikeb · Sep 7, 2015

Alternatively :-

Code:

 Sheets(mysheetname).Columns(InAry(Col)).Copy Destination:=Sheets("Volvo_Statistik").Columns(OutAry(Col))

hth

Rick Rothstein · Sep 7, 2015

elmnas said:
I have made a very long code....
But I want to make it shorter, but I don't know how...

This is untested, but I believe the following macro can replace the macro you posted in its entirety...

Code:

[table="width: 500"]
[tr]
	[td]Sub GetColData()
  Dim X As Long, Sht As Worksheet, Target As Worksheet, VS() As String, TS() As String
  Const Vehicles = ",Volvo_3P,VolVo_Penta,Volvo_Bus,Volvo_Business_Service,Volvo_Group_Trucks_Technology,Volvo_Information_Technology_AB,Volvo_Group_Sweden,Volvo_IT"
  Set Target = Sheets("Target_sheet")
  VS = Split("A,C,D,E,G,H,I,J,K,K,M,O", ",")
  TS = Split("A,D,H,I,J,K,L,M,E,F,U,AB", ",")
  For Each Sht In ThisWorkbook.Worksheets
    If InStr(Vehicles, "," & Sht.Name) Then
      For X = 0 To UBound(VS)
        Sht.Columns(VS(X)).Copy Target.Cells(1, TS(X))
      Next
    End If
  Next
End Sub[/td]
[/tr]
[/table]

elmnas · Sep 8, 2015

Rick Rothstein said:

This is untested, but I believe the following macro can replace the macro you posted in its entirety...

Code:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub GetColData()
  Dim X As Long, Sht As Worksheet, Target As Worksheet, VS() As String, TS() As String
  Const Vehicles = ",Volvo_3P,VolVo_Penta,Volvo_Bus,Volvo_Business_Service,Volvo_Group_Trucks_Technology,Volvo_Information_Technology_AB,Volvo_Group_Sweden,Volvo_IT"
  Set Target = Sheets("Target_sheet")
  VS = Split("A,C,D,E,G,H,I,J,K,K,M,O", ",")
  TS = Split("A,D,H,I,J,K,L,M,E,F,U,AB", ",")
  For Each Sht In ThisWorkbook.Worksheets
    If InStr(Vehicles, "," & Sht.Name) Then
      For X = 0 To UBound(VS)
        Sht.Columns(VS(X)).Copy Target.Cells(1, TS(X))
      Next
    End If
  Next
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Awesome works !!!!

ukmikeb · Sep 8, 2015

elmnas said:
Awesome works !!!!

Can I ask what the point of having all the sheets in the list is when the end result is that you are overwriting the data with the contents of the last sheet?

make shorter code

elmnas

Board Regular

Excel Facts

Arjan77

Board Regular

ukmikeb

Well-known Member

elmnas

Board Regular

ukmikeb

Well-known Member

ukmikeb

Well-known Member

Rick Rothstein

MrExcel MVP

elmnas

Board Regular

ukmikeb

Well-known Member

Similar threads

Forum statistics

Share this page

make shorter code

Board Regular

Excel Facts

Board Regular

Well-known Member

Board Regular

Well-known Member

Well-known Member

MrExcel MVP

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock