Recreate code

[elmnas]

Hello guys,

I have made following code,

But I want to create an array for sheets(mysheet1,mysheet2,mysheet3,mysheet4 etc)
instead of use hardcoded code.





Sub GetColData()


For Each sht In ThisWorkbook.Worksheets
mysheetname = sht.Name

If sht.Name Like "mysheet1"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

End If

If sht.Name Like "mysheet2" 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


End If

If sht.Name Like "mysheet3" 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


End If

If sht.Name Like "mysheet4" 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

End If



Next sht
End Sub




Could someone help me?

Thank you in advance

[snb]

Start removing all 'selects'; they are unnecessary in VBA and slow down your code considerably.

[mikerickson]

You could loop through a portion of the worksheets


For Each sht In ThisWorkbook.Worksheets(Array("mySheet1", "mySheet2", "mySheet4"))

[SamT]

For Help in the VBA Editor, (VBE,) place the cursor inside a keyword and press F1.

Option Explicit

Sub x()
Dim Sht As Worksheet
Dim Tsht As Worksheet

Set Tsht = ThisWorkbook.Sheets("Target_sheet")

For Each Sht In ThisWorkbook.Worksheets
'Excluding only one sheet. See alternate to exclude many sheets
If Not Sht Is Tsht Then
With Sht
.Range(Cells(1, "A"), Cells(Rows.Count, "A")).Copy _
Tsht.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'Repeat for Copying C>D and D>H
End With
End If
ShtNext:
Next Sht
End Sub

Sub alternate()
'
'
For Each Sht In ThisWorkbook.Worksheets
'To exclude many sheets
Select Case Sht.Name
Case "Target_Sheet", "another_sheet", "YAS"
GoTo ShtNext
End Select
'
'
'
End Sub