CODEWITHSUNDEEP
vbaexcel
znf96
znf96

Reputation: 61

Copy specific columns from multiple sheets into one

I'm new to VBA. I've been searching for hours but to no avail :(

I have 12 sheets which consist A-T columns. I wanted to copy and combine C and T columns from each of the 12 sheets into one workbook "Summary" by using macro. Can someone help me? Thanks in advance.

Sub Create_Summary()

Application.DisplayAlerts = False
On Error Resume Next

Application.DisplayAlerts = True
 n = Application.Worksheets.Count

Sheets("Summary").Move after:=Worksheets(Worksheets.Count)

Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
   If sh.Name <> "Summary" Then
    Set col = Columns(Columns.Count).End(xlToLeft)
      Set col = Columns(Columns.Count).End(xlToLeft)
        sh.Range("C:C,T:T").Copy Destination:=Sheets("Summary").Range(col,col)
    End If

Next sh

End Sub

This copy C and T columns from the last sheet, while the others just C without T.

Upvotes: 2

Views: 7146

Answers (1)

user3598756
user3598756

Reputation: 29421

try this

Option Explicit

Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long

Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)

For i = 1 To Worksheets.Count - 1 ' once you moved "Summary" sheet as the workbook last one, you skip it by limiting loop to the penultimate sheets index
    Worksheets(i).Range("C:C,T:T").Copy Destination:=sumSht.Cells(1, sumSht.Columns.Count).End(xlToLeft).Offset(, 1) ' qualify all destination references to "Summary" sheet
Next i
sumSht.Columns(1).Delete ' "Summary" sheet first column gest skipped by the above loop, so delete it

End Sub

it's commented so that you can follow it and make your changings

Upvotes: 2

Related Questions