Reference Workbooks

[btyturtle]

Hi,

Please help. I am writing a code that need to copy from a "Source" workbook and paste to a new workbook (or "Target" workbook).

So, basically I will have three workbooks involve;
1. Workbook where the VBA code is running
2. From the first workbook, I will add a "Target" workbook
3. Then, I am doing a Do While ... Loop to open workbooks in a folder, and call a subroutine to copy from "Source" workbook and paste to "Target" workbook.

I have been trying to make a workflow that allow VBA run smoothly without confusing it which workbook should it copy/paste from/to, with no luck. My problems are after adding a workbook, the code will not run. I would try to activate the first workbook by using ThisWorkbooks.Activate. Then, it run the code again. And then, I haven't figured out how I would ask the code to paste into "Target" workbook. I also haven't figured out at what point I should refer back to ThisWorkbooks.Activate again.

What will be the best way to do this? Thank you.

Sub DataOrganizer()
'
'   first create a new Workbook, this is where all the data will be stored, so it's a Target workbook
'
    
    Dim fNameT As String
    
        Workbooks.Add
        Application.DisplayAlerts = False
        fNameT = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx")
        ActiveWorkbook.SaveAs filename:=fNameT
        Application.DisplayAlerts = True
            
    ThisWorkbook.Activate 'without this macro stop at above procedure
    
'   to choose folder to open files
    Dim FolderPath As String
    Dim fNameS As String
    Dim wbS As Workbook
    
    With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    FolderPath = .SelectedItems(1)
    End With
    
    fNameS = Dir(FolderPath & "\*.csv")
    
'   the loop to open file and organize data start here
    Do While fNameS <> ""
        Application.ScreenUpdating = False
            Set wbS = Workbooks.Open(FolderPath & "\" & fNameS)
        
'   there will be subroutine to be called to arrange data appropriately
                
'   cut and paste visible cell from autofilter result into target workbook
    Dim copyR As Range
    Set copyR = Range("$D$4:H" & Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    copyR.Copy 

'   still do not know how to refer back to the Target workbook
'   also have to close the Source workbook w/o saving before opening the next file in the folder
        
    '   to open the next file
        filename = Dir
    Loop
         Application.ScreenUpdating = True 'until the last file detected
End Sub

 

[btyturtle]

A little edit on the code I provided earlier

• Sub DataOrganizer()
  '
  ' first create a new Workbook, this is where all the data will be stored, so it's a Target workbook
  '
  
  Dim fNameT As String
  
  Workbooks.Add
  Application.DisplayAlerts = False
  fNameT = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx")
  ActiveWorkbook.SaveAs filename:=fNameT
  Application.DisplayAlerts = True
  
  ThisWorkbook.Activate 'without this macro stop at above procedure
  
  ' to choose folder to open files
  Dim FolderPath As String
  Dim fNameS As String
  Dim wbS As Workbook
  
  With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  If .Show = False Then Exit Sub
  FolderPath = .SelectedItems(1)
  End With
  
  fNameS = Dir(FolderPath & "\*.csv")
  
  ' the loop to open file and organize data start here
  Do While fNameS <> ""
  Application.ScreenUpdating = False
  Set wbS = Workbooks.Open(FolderPath & "\" & fNameS)
  
  ' there will be subroutine to be called to arrange data appropriately
  
  ' cut and paste visible cell from autofilter result into target workbook
  Dim copyR As Range
  Set copyR = Range("$D$4:H" & Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
  copyR.Copy
  
  ' still do not know how to refer back to the Target workbook
  ' also have to close the Source workbook w/o saving before opening the next file in the folder
  
  ' to open the next file
  fNameS = Dir
  Loop
  Application.ScreenUpdating = True 'until the last file detected
  End Sub
  ​

Posting Permissions

 

[Norie]

ThisWorkbook refers to the workbook the code is in.

If you want to refer to the workbook you create in the code create a reference to it when you create it.

Sub DataOrganizer()
'
' first create a new Workbook, this is where all the data will be stored, so it's a Target workbook
'
Dim wbTarget As Workbook
Dim wbS As Workbook
Dim copyR As Range
Dim FolderPath As String
Dim fNameS As String
Dim fNameT As String

    Set wbTarget = Workbooks.Add

    Application.DisplayAlerts = False
    fNameT = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx")
    wbTarget.SaveAs filename:=fNameT
    Application.DisplayAlerts = True

    ' to choose folder to open files

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        FolderPath = .SelectedItems(1)
    End With

    fNameS = Dir(FolderPath & "\*.csv")

    ' the loop to open file and organize data start here
    Do While fNameS <> ""

        Application.ScreenUpdating = False
        Set wbS = Workbooks.Open(FolderPath & "\" & fNameS)

        ' there will be subroutine to be called to arrange data appropriately

        ' cut and paste visible cell from autofilter result into target workbook
        With wbS.ActiveSheet
            Set copyR = .Range("$D$4:H" & .Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
            copyR.Copy wbTarget.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
        End With

        ' to open the next file
        fNameS = Dir
    Loop
    Application.ScreenUpdating = True 'until the last file detected

End Sub

Note, since I don't know where you want to copy to I've added some sample code that will copy to the next available row of the active sheet of the target workbook.