VBA Mac - Advice on pasting values into next empty column

VBA learner ITG

Active Member
Joined
Apr 18, 2017
Messages
267
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello peers,

I appreciate this has been asked numerous times and i have tried google search and to no avail in amending the code below to paste in the next empty column in the workbook the data is being copied to.

for some reason its pasting the values at the bottom row of the workbook in column A. when it should be pasting values into the next empty column between row 4 and 8.


Code:
            wsCopyFrom.Range("E5:AA8").Copy
            wsCopyTo.Cells(Columns.Count, 1).End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteValues


The code below is taken from Ron De Bruin website which has been created for the Mac. I need to maintain the structure of Ron code as possible as this code is being ran on a mac operating system.


Any advice would be appreciated.






Code:
'Important: this Dim line must be at the top of your module
Dim MyFiles As String
 
Sub RON_DE_BRUIN()
'
' RON_DE_BRUIN Macro
 
 
    Dim MySplit As Variant
    Dim FileInMyFiles As Long
    Dim Fstr As String
    Dim LastSep As String
    Dim wbCopyTo    As Workbook
    Dim wsCopyTo    As Worksheet
    Dim wbCopyFrom  As Workbook
    Dim wsCopyFrom  As Worksheet
 
    Set wbCopyTo = ActiveWorkbook
    Set wsCopyTo = wbCopyTo.Sheets("DATA")
 
 
    'Note: I use cell references in this macro to make it easy to test the code
    'Normally you will use it like this :
    'Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, FileFilterOption:=0, FileNameFilterStr:="SearchString")
 
    'Clear MyFiles to be sure that it not return old info if no files are found
    MyFiles = ""
 
    'Fill the MyFiles string with the files if they match your criteria
    Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, FileFilterOption:=0, FileNameFilterStr:="")
    'Level                     : 1= Only the files in the folder, 2 to ? levels of subfolders
    'ExtChoice             :  0=(xls|xlsx|xlsm|xlsb), 1=xls , 2=xlsx, 3=xlsm, 4=xlsb, 5=csv, 6=txt, 7=all files, 8=(xlsx|xlsm|xlsb), 9=(csv|txt)
    'FileFilterOption     :  0=No Filter, 1=Begins, 2=Ends, 3=Contains
    'FileNameFilterStr   : Search string used when FileFilterOption = 1, 2 or 3
 
 
    'This code below will list all files on the first sheet of this workbook
    'In column A :B the path/name, C the file date/time and D the size
    'You can browse to the folder you want when the code Run
 
    'In this example we list the file names but you can also use MySplit(FileInMyFiles)
    'in the loop to for example to open the files with Workbooks.Open(MySplit(FileInMyFiles))
 
    If MyFiles <> "" Then
        Application.ScreenUpdating = False
 
        'Split MyFiles and loop through all the files
       MySplit = Split(MyFiles, Chr(13))
        For FileInMyFiles = LBound(MySplit) To UBound(MySplit)
            On Error Resume Next
            Set wbCopyFrom = Workbooks.Open(MySplit(FileInMyFiles))
            Set wsCopyFrom = wbCopyFrom.Worksheets(1)
 
            Application.CutCopyMode = False
 
            Set oneRange = Range("E5:DH8")
            Set aCell = Range("E5")
       
 
       
'THIS IS THE CODE TO COPY THE COLUMN TITLE HEADERS FROM IMPORT DOCUMENT TO DATA TAB ON MASTER
 
            wsCopyFrom.Range("E5:AA8").Copy
            wsCopyTo.Cells(Columns.Count, 1).End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteValues
 
   
            Application.CutCopyMode = False
       
            wbCopyFrom.Close False
            On Error GoTo 0
        Next FileInMyFiles
        On Error Resume Next
       
'''''''''HERE IS THE CODE TO MATCH THE ROW DATA BACK TO THE DATA TAB
       
        
 
       
 
        Application.ScreenUpdating = True
       
    Else
        MsgBox "Sorry no files that match your criteria, A 0 files result can be due to Apple sandboxing: Try using the Browse button to re-select the folder."
        'ScreenUpdating is still True but we set it to true again to refresh the screen,
        Application.ScreenUpdating = True
   End If
 
End Sub
 
 
'*******Function that do all the work that will be called by the macro*********
 
Function GetFilesOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long, _
                                              FileFilterOption As Long, FileNameFilterStr As String)
'Ron de Bruin,Version 4.0: 27 Sept 2015
'http://www.rondebruin.nl/mac.htm
'Thanks to DJ Bazzie Wazzie and Nigel Garvey(posters on MacScripter)
    Dim ScriptToRun As String
    Dim folderPath As String
    Dim FileNameFilter As String
    Dim Extensions As String
 
    On Error Resume Next
    folderPath = MacScript("choose folder as string")
    If folderPath = "" Then Exit Function
    On Error GoTo 0
 
    Select Case ExtChoice
    Case 0: Extensions = "(xls|xlsx|xlsm|xlsb)"  'xls, xlsx , xlsm, xlsb
    Case 1: Extensions = "xls"    'Only  xls
    Case 2: Extensions = "xlsx"    'Only xlsx
    Case 3: Extensions = "xlsm"    'Only xlsm
    Case 4: Extensions = "xlsb"    'Only xlsb
    Case 5: Extensions = "csv"    'Only csv
    Case 6: Extensions = "txt"    'Only txt
    Case 7: Extensions = ".*"    'All files with extension, use *.* for everything
    Case 8: Extensions = "(xlsx|xlsm|xlsb)"  'xlsx, xlsm , xlsb
    Case 9: Extensions = "(csv|txt)"   'csv and txt files
        'You can add more filter options if you want,
    End Select
 
    Select Case FileFilterOption
    Case 0: FileNameFilter = "'.*/[^~][^/]*\\." & Extensions & "$' "  'No Filter
    Case 1: FileNameFilter = "'.*/" & FileNameFilterStr & "[^~][^/]*\\." & Extensions & "$' "    'Begins with
    Case 2: FileNameFilter = "'.*/[^~][^/]*" & FileNameFilterStr & "[URL="file://."]\\.[/URL]" & Extensions & "$' "    ' Ends With
    Case 3: FileNameFilter = "'.*/([^~][^/]*" & FileNameFilterStr & "[^/]*|" & FileNameFilterStr & "[^/]*)\\." & Extensions & "$' "   'Contains
    End Select
 
    folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
                           Chr(34) & " to return quoted form of it's POSIX Path")
    folderPath = Replace(folderPath, "'\''", "'\\''")
 
    If Val(Application.Version) < 15 Then
        ScriptToRun = ScriptToRun & "set foundPaths to paragraphs of (do shell script """ & "find -E " & _
                      folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                      Level & """)" & Chr(13)
        ScriptToRun = ScriptToRun & "repeat with thisPath in foundPaths" & Chr(13)
        ScriptToRun = ScriptToRun & "set thisPath's contents to (POSIX file thisPath) as text" & Chr(13)
        ScriptToRun = ScriptToRun & "end repeat" & Chr(13)
        ScriptToRun = ScriptToRun & "set astid to AppleScript's text item delimiters" & Chr(13)
        ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to return" & Chr(13)
       ScriptToRun = ScriptToRun & "set foundPaths to foundPaths as text" & Chr(13)
        ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to astid" & Chr(13)
        ScriptToRun = ScriptToRun & "foundPaths"
    Else
        ScriptToRun = ScriptToRun & "do shell script """ & "find -E " & _
                      folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                      Level & """ "
    End If
    On Error Resume Next
    MyFiles = MacScript(ScriptToRun)
    On Error GoTo 0
End Function
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Forum statistics

Threads
1,214,918
Messages
6,122,257
Members
449,075
Latest member
staticfluids

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top