VBA learner ITG
Active Member
- Joined
- Apr 18, 2017
- Messages
- 272
- Office Version
- 365
- Platform
- Windows
- 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.
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.
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