VirtualBrainAche
New Member
- Joined
- Apr 13, 2020
- Messages
- 1
- Office Version
- 365
- Platform
- Windows
Hey guys,
New to the VBA scene and have embarked on the learning journey. I am having trouble with my first major project.
For Context: I have around 100 different workbooks in which i need to copy and paste below each other into a new workbook. I have gotten so close!!! when I run the script it is pasting next to each other (pasting in a new column each time and not a row. Below is the code I have and i believe I have done the green highlighted text incorrectly. I have spent hours trying to get this to work and would love a fresh set of eyes over this. I need this script to post below the last pasted cell (+1 one row down for space)
' Procedure to copy the data.
New to the VBA scene and have embarked on the learning journey. I am having trouble with my first major project.
For Context: I have around 100 different workbooks in which i need to copy and paste below each other into a new workbook. I have gotten so close!!! when I run the script it is pasting next to each other (pasting in a new column each time and not a row. Below is the code I have and i believe I have done the green highlighted text incorrectly. I have spent hours trying to get this to work and would love a fresh set of eyes over this. I need this script to post below the last pasted cell (+1 one row down for space)
VBA Code:
Sub CopyDataBetweenWorkbooks()
Dim wbSource As Workbook
Dim shTarget As Worksheet
Dim shSource As Worksheet
Dim strFilePath As String
Dim strPath As String
' Initialize some variables and
' get the folder path that has the files
Set shTarget = ThisWorkbook.Sheets("sheet1")
strPath = GetPath
' Make sure a folder was picked.
If Not strPath = vbNullString Then
' Get all the files from the folder
strfile = Dir$(strPath & "*.xlsx", vbNormal)
Do While Not strfile = vbNullString
' Open the file and get the source sheet
Set wbSource = Workbooks.Open(strPath & strfile)
Set shSource = wbSource.Sheets("Board Approved Forecast")
'Copy the data
Call CopyData(shSource, shTarget)
'Close the workbook and move to the next file.
wbSource.Close False
strfile = Dir$()
Loop
End If
End Sub
' Procedure to copy the data.
Rich (BB code):
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)
Const strRANGE_ADDRESS As String = "A1:b106"
Dim lCol As Long
'Determine the last column.
lCol = shTarget.Cells(8, shTarget.Columns.Count).End(xlToLeft).Column + 1
'Copy the data.
shSource.Range(strRANGE_ADDRESS).Copy
shTarget.Cells(8, lCol).PasteSpecial xlPasteValuesAndNumberFormats
' Reset the clipboard.
Application.CutCopyMode = xlCopy
End Sub
' Function to get the folder path
Function GetPath() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Select a folder"
.Title = "Folder Picker"
.AllowMultiSelect = False
'Get the folder if the user does not hot cancel
If .Show Then GetPath = .SelectedItems(1) & "\"
End With
End Function
Last edited by a moderator: