Need help in vb code to fetch sheet names

[Ateeb Ali]

I am using following code and it copied all data from all the sheets in a worksheet.
I also need help that al last column sheet name also pasted so We can know the data coped from which sheet.

>>> use code - tags <<<

Sub ListSheetNamesInNewWorkbook()
    Dim objNewWorkbook As Workbook
    Dim objNewWorksheet As Worksheet

    Set objNewWorkbook = Excel.Application.Workbooks.Add
    Set objNewWorksheet = objNewWorkbook.Sheets(1)

    For i = 1 To ThisWorkbook.Sheets.Count
        objNewWorksheet.Cells(i, 1) = i
        objNewWorksheet.Cells(i, 2) = ThisWorkbook.Sheets(i).Name
    Next i

    With objNewWorksheet
         .Rows(1).Insert
         .Cells(1, 1) = "INDEX"
         .Cells(1, 1).Font.Bold = True
         .Cells(1, 2) = "NAME"
         .Cells(1, 2).Font.Bold = True
         .Columns("A:B").AutoFit
    End With
End Sub

 

[rlv01]

I am using following code and it copied all data from all the sheets in a worksheet.

I do not understand. The code you posted does not copy anything at all.

 

[Ateeb Ali]

I do not understand. The code you posted does not copy anything at all.

I am sorry, attaching correct code;

>>> use code - tags <<<

Sub CopyToMaster()
 
ShtCount = ActiveWorkbook.Sheets.Count
 
For i = 2 To ShtCount
 
Worksheets(i).Activate
LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
 
Range("A2:J" & LastRow).Select
 
Selection.Copy
Sheets("Master").Activate
 
LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Select
 
'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
 
ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial
 
 
Next i
End Sub

 

[rlv01]

Perhaps something like this.

Sub CopyToMaster()
    Dim ShtCount As Long, i As Long, LastRow As Long
    Dim WSName As String, CopyRange As Range, DestRange As Range

    ShtCount = ActiveWorkbook.Sheets.Count
    Sheets("Master").Activate

    For i = 2 To ShtCount
        With Worksheets(i)
            WSName = .Name
            LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
            Set CopyRange = .Range("A2:J" & LastRow)
        End With

        With Worksheets("Master")
            LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
            If LastRow = 1 Then
                Set DestRange = .Range("A" & LastRow)
            Else
                Set DestRange = .Range("A" & LastRow + 1)
            End If
        End With

        'PasteSpecial
        CopyRange.Copy
        DestRange.PasteSpecial xlPasteAll
        
        'Write source sheet name
        With CopyRange
            ActiveCell.Offset(0, .Columns.Count).Resize(.Rows.Count, 1).Value = WSName
            ActiveCell.Offset(.Rows.Count).Select
        End With
    Next i
End Sub