copy data from one excel file to another

[Matthieu]

Hi All,

I've an array in one excel file from which i'm trying to copy rows to other excel files, basically from my source file i'm copying each row to within a table to different destinations Excel files, the destination rows is fix but I need to loop through my roughs on the source file which don't get how to do that in VBA for Excel, basically I'm stuck at the first row when it's about gathering the data from the source file, I have tried nested

for loop

but it's getting crazy and doesn't really does the deal, I look at the

 with...end

with but didn't really get how it works so never manage to get something.

I'm finally doing kind of a basic copy and paste but always only the first row of the source file, here is my code, hop this is clear enough to get what's my issue.

Sub maMacro()
Dim x As Integer
Dim xRet As Boolean
Dim workbookPath As String
Dim fullPath As String
Dim SourceSelection As Range
    
    'Get the current workbook path to build the path for the other workbook we want to open.
    workbookPath = ActiveWorkbook.Path
    'Get the number of row to loop until the last one containing data
    NumRows = Range("A5", Range("A5").End(xlDown)).Rows.Count

    Application.ScreenUpdating = False
    'Set the cell from which everything starts.
    Range("A5").Select
    'Set the first Range from which we are retreving the data.
    Set SourceSelection = Range("B5:M5")
    For x = 1 To NumRows
        'Get the value of the cell to open the corresponding excel file.
        cell = ActiveCell.Value
        'get the fullpath of the workbook to open it afterward
        fullPath = workbookPath & Application.PathSeparator & cell & ".xlsx"
        'Check if workbook is open
        xRet = isWorkbookOpen(cell & ".xlsx")
        If xRet Then ' if the workbook is open do this
        ' Copy data from Source Excel file from which the macro is trigger to destination one
            Workbooks(cell & ".xlsx").Sheets("sheet1").Range("F26:Q26").Value = SourceSelection.Value
            Workbooks(cell & ".xlsx").Close (True)

        Else 'if the workbook is not open do that
            'Open the workbook before doing the copy
             Workbooks.Open fullPath
             ' Copy data from Source Excel file from which the macro is trigger to destination one
             Workbooks(cell & ".xlsx").Sheets("sheet1").Range("F26:Q26").Value = SourceSelection.Value
'           'Close and save once it's done
            Workbooks(cell & ".xlsx").Close (True)
        End If
        'Get the data from the next row Obviously my issue is here... it doesn't update the variable but the source Excel file instead...
        SourceSelection.Value = SourceSelection.Offset(1, 0).Value
        'Grab the next file name from the colonne A
        ActiveCell.Offset(1, 0).Select
    Next
    Application.ScreenUpdating = True
    MsgBox "Update done Enjoy your Day !"

End Sub
'Function to check if the workbook is open
Function isWorkbookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    isWorkbookOpen = (Not xWb Is Nothing)
End Function

'''''''''''''''''''''''''''''''''''''''''''''
' Below is only for testing purpose
'''''''''''''''''''''''''''''''''''''''''''''

Function getFileName(employeeName As String) As Variant
    employeeFileName = Application.GetOpenFilename(employeeName)
    Debug.Print employeeFileName
End Function

Sub open_workbook_dialog()
    Dim myFilname As Variant
    
    myFilname = Application.GetOpenFilename(filefilter:="Excel Files,*xl*")
    
    Debug.Print "myFilename " & myFilename
    Debug.Print "ActiveWorkbook.Path " & ActiveWorkbook.Path
    Debug.Print "Path " & Path
        
End Sub

Thanks for any input !

Matth

 

[Fluff]

Not sure if I've fully understood you, but try this

Sub maMacro()

    Dim workbookPath As String
    Dim Cl As Range
    Dim Wbk As Workbook
    
    'Get the current workbook path to build the path for the other workbook we want to open.
    workbookPath = ActiveWorkbook.Path

    Application.ScreenUpdating = False
    
    For Each Cl In Range("A5", Range("A5").End(xlDown))
        
        On Error Resume Next
        If Workbooks(Cl.Value & ".xls") Is Nothing Then
            Set Wbk = Workbooks.Open(workbookPath & Application.PathSeparator & Cl.Value & ".xls")
        End If
        On Error GoTo 0

'         Copy data from Source Excel file from which the macro is trigger to destination one
        Wbk.Sheets("sheet1").Range("F26:Q26").Value = Cl.Offset(, 1).Resize(, 12).Value
        Wbk.Close (False)

    Next Cl
    Application.ScreenUpdating = True
    MsgBox "Update done Enjoy your Day !"

End Sub

 

[Fluff]

Another option is

Sub maMacro()

    Dim workbookPath As String
    Dim Cl As Range
    Dim Wbk As Workbook
    
    'Get the current workbook path to build the path for the other workbook we want to open.
    workbookPath = ActiveWorkbook.Path

    Application.ScreenUpdating = False
    
    For Each Cl In Range("A5", Range("A5").End(xlDown))
        On Error Resume Next
        If Workbooks(Cl.Value & ".xlsx") Is Nothing Then     'Checks if the workbook is open
            On Error GoTo 0
            Set Wbk = Workbooks.Open(workbookPath & Application.PathSeparator & Cl.Value & ".xlsx")
        Else
            Set Wbk = Workbooks(Cl.Value & ".xlsx")
        End If
        If Not Wbk.ReadOnly Then            'Checks if the workbook is readonly
'           Copy data from Source Excel file from which the macro is trigger to destination one
            Wbk.Sheets("sheet1").Range("F26:Q26").Value = Cl.Offset(, 1).Resize(, 12).Value
            Wbk.Close (True)
        Else
            MsgBox "Workbook " & Cl.Value & " is ""ReadOnly""", vbCritical, "Read Only"
            Wbk.Close (False)
        End If
    Next Cl
    Application.ScreenUpdating = True
    MsgBox "Update done Enjoy your Day !"

End Sub

This will check if the workbook is readonly

 

[Matthieu]

Sugoi ! I'm impressed how few lines of codes it requires ! I was going into a too much complex one!


Thanks for the help and get me learning more on VBA!

Kindly

Matth

 

[Fluff]

Glad to help & thanks for the feedback