I have a Master File and Source File.
Master File: Multiple worksheets, Column A to Q
Source File: Multiple Worksheets, Column A to Q
I am a VBA newbie. But after referring forums and etc, I managed to
1) prompt window to select Source File
2) with the help of users in MrExcel, I managed to have the looping of worksheets done.
Now,
I need to copy from Column Q of Source File from each worksheet that has the same name with worksheet in Master File by matching value in Column A
And Paste it to next available columns in Master File, starting from Column R. If R is not empty, then paste to S and it goes on.
Master File: Multiple worksheets, Column A to Q
Source File: Multiple Worksheets, Column A to Q
I am a VBA newbie. But after referring forums and etc, I managed to
1) prompt window to select Source File
2) with the help of users in MrExcel, I managed to have the looping of worksheets done.
Now,
I need to copy from Column Q of Source File from each worksheet that has the same name with worksheet in Master File by matching value in Column A
And Paste it to next available columns in Master File, starting from Column R. If R is not empty, then paste to S and it goes on.
Code:
Sub CommandButton2_Click()
Dim fileDialog As fileDialog
Dim strPathFile As String
Dim dialogTitle As String
Dim wbSource As Workbook, Mwb As Workbook
Dim Ws As Worksheet, Mws As Worksheet
Dim Cl As Range
Dim FR As Long
Dim emptyColumn As Long
Set Mwb = ThisWorkbook
dialogTitle = "Navigate to and select required file."
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
With fileDialog
.InitialFileName = "C:\Users\User\Documents"
.AllowMultiSelect = False
.Filters.Clear
.Title = dialogTitle
If .Show = False Then
MsgBox "File not selected to import. Process Terminated"
Exit Sub
End If
strPathFile = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Set wbSource = Workbooks.Open(Filename:=strPathFile)
For Each Ws In wbSource.Worksheets
If ShtExists(Ws.Name, Mwb) Then
Set Mws = Mwb.Sheets(Ws.Name)
emptyColumn = Mws.Cells(3, Mws.Columns.Count).End(xlToLeft).Column
If emptyColumn > 1 Then
emptyColumn = emptyColumn + 1
End If
For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
FR = 0
On Error Resume Next
FR = Application.Match(Cl.Value, Ws.Columns(1), 0)
On Error GoTo 0
If FR <> 0 Then Mws.Range("Q" & FR).Value = Cl.Offset(, emptyColumn)
Next Cl
End If
Set Mws = Nothing
Next Ws
wbSource.Close SaveChanges:=False
End Sub
Public Function ShtExist(ShtName As String, Optional Wbk As Workbook) As Boolean
If Wbk Is Nothing Then Set Wbk = ActiveWorkbook
On Error Resume Next
ShtExist = (LCase(Wbk.Sheets(ShtName).Name) = LCase(ShtName))
On Error GoTo 0
End Function
