laptop

Sub CopyThreeSheetsToNewWorkbook()
    Dim wbSource As Workbook
    Dim wbDestination As Workbook
    Dim sheetNames As Variant
    Dim wsSource As Worksheet, wsDestination As Worksheet
    Dim rngSource As Range
    Dim lastRow As Long, lastCol As Long
    Dim i As Long
 
    ' Set reference to the source workbook (current workbook)
    Set wbSource = ThisWorkbook
 
    ' Define the sheet names to copy
    sheetNames = Array("myAdmin", "Temp", "Sheet1")
 
    ' Create a new workbook for the destination
    Set wbDestination = Workbooks.Add
 
    ' Loop through each sheet to copy data
    For i = LBound(sheetNames) To UBound(sheetNames)
        ' Set source and destination worksheets
        Set wsSource = wbSource.Sheets(sheetNames(i))
        If i = 0 Then
            Set wsDestination = wbDestination.Sheets(1)
        Else
            Set wsDestination = wbDestination.Sheets.Add(After:=wbDestination.Sheets(wbDestination.Sheets.Count))
        End If
        wsDestination.Name = wsSource.Name
 
        ' Determine the range to copy
        lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
        lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
        Set rngSource = wsSource.Range("A1", wsSource.Cells(lastRow, lastCol))
 
        ' Copy and paste data
        rngSource.Copy
        wsDestination.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    Next i
 
    MsgBox "Data from three sheets has been copied successfully!", vbInformation
End Sub

End Sub

Loading

Scroll to Top