Data transfering from one workbook to another using VBA code

[Reza_Majdmrmajd]

Hello everyone.

I have an issue with below code. it make the new sheet with the name that i choose from a cell but the data does not transfer from the source file that I already selected. try many different approaches.

Here is the code:

Option Explicit

Dim SelectedFilePath As String ' Module-level variable to store the file path
Dim ClientName As String

Sub SelectFile()
' Use InputBox for file selection
SelectedFilePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", Title:="Select Excel File")

' Check if a file was selected
If SelectedFilePath <> "False" Then
' Display the selected file path
MsgBox "Selected File: " & SelectedFilePath
Else
' User canceled the file selection
MsgBox "File selection canceled."
End If
End Sub

Sub CopyDataToNewSheet()
' Check if a file has been selected
If SelectedFilePath = "" Then
MsgBox "No file has been selected.", vbExclamation
Exit Sub
End If

' Get the client name from Sheet1 $H$3
ClientName = Worksheets("Sheet1").Range("H3").Value

' Check if the client name is not empty
If ClientName <> "" Then
' Check if the client name is a valid sheet name
If IsValidSheetName(ClientName) Then
' Attempt to open the workbook
On Error Resume Next
Dim wb As Workbook
Set wb = Workbooks.Open(SelectedFilePath)
On Error GoTo 0

' Check if the workbook was successfully opened
If Not wb Is Nothing Then
' Assume the data is in the first sheet (modify as needed)
Dim sourceSheet As Worksheet
Set sourceSheet = wb.Sheets(1)

' Create a new sheet only if it doesn't exist
On Error Resume Next
Dim newSheet As Worksheet
Set newSheet = Worksheets(ClientName)
On Error GoTo 0

If newSheet Is Nothing Then
Set newSheet = Worksheets.Add
newSheet.Name = ClientName
End If

' Find the last row in column L of the source sheet
Dim lastRow As Long
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "L").End(xlUp).Row

' Transfer data from columns L, N, O, P, Q to the new sheet
sourceSheet.Range("L3:Q" & lastRow).Copy Destination:=newSheet.Range("B3:F" & lastRow)

' Calculate Grand Total
newSheet.Cells(lastRow + 1, 5).Value = "Grand Total"
newSheet.Cells(lastRow + 1, 6).Formula = "=SUM(F3:F" & lastRow & ")"

' Close the source workbook
wb.Close SaveChanges:=False

' Inform the user
MsgBox "Data copied to a new sheet named '" & ClientName & "'.", vbInformation
Else
MsgBox "Error opening the selected file.", vbExclamation
End If
Else
' Invalid sheet name
MsgBox "Invalid client name. Please provide a valid sheet name.", vbExclamation
End If
Else
' Client name not found
MsgBox "Client name not found in Sheet1 $H$3.", vbExclamation
End If
End Sub

Function IsValidSheetName(sheetName As String) As Boolean
On Error Resume Next
Worksheets.Add(, , 1, xlWorksheet).Name = sheetName
IsValidSheetName = (Err.Number = 0)
On Error GoTo 0
End Function

other approaches are:

1- Direct Value Assignment:

newSheet.Range("B3:F" & lastRow).Value = sourceSheet.Range("L3:Q" & lastRow).Value

2- Copy Method:

sourceSheet.Range("L3:Q" & lastRow).Copy Destination:=newSheet.Range("B3:F" & lastRow)

3- Loop with Value Assignment:

For i = 3 To lastRow
newSheet.Cells(i, 2).Value = sourceSheet.Cells(i, 12).Value ' Column L
newSheet.Cells(i, 3).Value = sourceSheet.Cells(i, 14).Value ' Column N
newSheet.Cells(i, 4).Value = sourceSheet.Cells(i, 15).Value ' Column O
newSheet.Cells(i, 5).Value = sourceSheet.Cells(i, 16).Value ' Column P
newSheet.Cells(i, 6).Value = sourceSheet.Cells(i, 17).Value ' Column Q
Next i

Im using Excel for Mac Version 16.78.3 Please help!

Thanks

[#2]

What exactly happens? Which error do you get (if any) and if you click Debug, which line is yellow?
Have you tried stepping through the code to see which "turns" it takes?

[#3]

@Jan Karel Pieterse thanks for your reply, there is no error at all the macro runs, it make the new sheet with the name in the defined cell but no data is transferring to that sheet. No error at all it goes to the end of subroutine 

[#4]

@Reza_Majdmrmajd After analyzing your code, there are a number of things I would do differently. Having said that, the problem you're experiencing is a result of not directly identifying which workbook the "newSheet" is referring to. When you use:

Set newSheet = Worksheets(ClientName)

and:

Set newSheet = Worksheets.Add

...the action is being perform on the "ActiveWorkbook", which at this point in the procedure is the source workbook "wb". Since you later use:

' Close the source workbook
    wb.Close SaveChanges:=False

...to close "wb" without saving changes, I'm assuming that it was your intention to copy the source data to a new sheet in the current workbook. To do so, you need to add "ThisWorkbook" to each line:

Set newSheet = ThisWorkbook.Worksheets(ClientName)

and:

Set newSheet = ThisWorkbook.Worksheets.Add

I hope that helps. Cheers!