I'm trying to create a macro that will compile specific columns from all worksheets in a workbook into a single new worksheet.
What I have so far creates the new sheet, and returns the correct headers for each column, but copies across all columns from the existing sheets rather than just the columns I have specified.
As can be seen with the column headings, I would like to only copy the values in columns A:I, K:M, R and W:Y from sheets 2 onwards, into columns B:O in the "MASTER" worksheet.
Does anyone have any suggestions as to how I can get this working?
What I have so far creates the new sheet, and returns the correct headers for each column, but copies across all columns from the existing sheets rather than just the columns I have specified.
As can be seen with the column headings, I would like to only copy the values in columns A:I, K:M, R and W:Y from sheets 2 onwards, into columns B:O in the "MASTER" worksheet.
Does anyone have any suggestions as to how I can get this working?
VBA Code:
Sub Combine2()
Dim J As Integer, wsNew As Worksheet
Dim rngCopy As Range, rngPaste As Range
Dim Location As String
On Error Resume Next
Set wsNew = Sheets("MASTER")
On Error GoTo 0
'if sheet does not already exist, create it
If wsNew Is Nothing Then
Set wsNew = Worksheets.Add(Before:=Sheets(1)) ' add a sheet in first place
wsNew.Name = "MASTER"
End If
'copy headings and paste to new sheet starting in B1
With Sheets(2)
.Range("A1:I1").Copy wsNew.Range("B1")
.Range("R1").Copy wsNew.Range("K1")
.Range("K1:M1").Copy wsNew.Range("L1")
.Range("W1:Y1").Copy wsNew.Range("O1")
End With
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
'save sheet name/location to string
Location = Sheets(J).Name
'set range to be copied
With Sheets(J).Range("A1").CurrentRegion
Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
'set range to paste to, beginning with column B
Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'copy range and paste to column *B* of combined sheet
rngCopy.Copy rngPaste
'enter the location name in column A for all copied entries
Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location
Next J
With Sheets(1)
Range("A1").Value = "Extract Date"
Range("A1").Font.Bold = True
Columns("A:T").AutoFit
End With
' wsNew.Visible = xlSheetHidden
End Sub