PDA

View Full Version : [SOLVED] Copy and paste data from a source file to destination file.



spittingfire
10-08-2016, 08:29 AM
Hi All,

I have two different workbooks, "Overall Groups.xls" and "t2.xlsm".

What I will like to do is have a vba in "t2.xlsm" that will pull specific data from "Overall Groups.xls"

The data will be pulled based on what is selected from the list in cell F1

The relationships are in columns G and H.

What I want is if I select "TSRE" from the list in cell F1 then the vba should open the "Overall Groups.xls" file and first check if the date in column B matches today's date - if it matches them I will need it to find "AL - ALTSRT" in column A and paste all the values from column H (48 rows) in Column B starting at B2 in the "t2.xlsm" file. Once done it will then find "HGS - HGTSRI" in column A and paste all the values from column H (48 rows) in Column C starting at C2 in the "t2.xlsm" file and finally after that it will find "OLS - HGTSRT" in column A and paste all the values from column H (48 rows) in Column D starting at D2 in the "t2.xlsm". If "WCTE" is selected then it only needs to "AL - ALWCTE" from the "Overall Groups.xls" file and and paste all the values from column H (48 rows) in Column B starting at B2 in the "t2.xlsm" file.

If it can not find a match then just return values of zeros.

If the date does not match today's date then just return an error message stating "the date does not match".

I have attached both workbooks with data and any help would be appreciated.

mana
10-08-2016, 07:49 PM
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim ws As Worksheet
Const myPath = "C:\***\***\Overall Groups.xls"

If Target.Address <> "$F$1" Then Exit Sub

Application.EnableEvents = False
Range("B2").Resize(48, 3).ClearContents
If Target.Value = "" Then
Application.EnableEvents = True
Exit Sub
End If

Set wb = Workbooks.Open(myPath)
Set ws = wb.Worksheets(1)

With ws.Range("a1").CurrentRegion
.AutoFilter
.AutoFilter 2, ">=" & CLng(Date), xlAnd, "<" & CLng(Date) + 1

If .Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "the date does not match"
Else
If Target.Value = "TSRE" Then
.AutoFilter 1, "AL - ALTSRT"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Intersect(.Offset(1), .Columns("h")).Copy Range("b2")
End If
.AutoFilter 1, "HGS - HGTSRI"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Intersect(.Offset(1), .Columns("h")).Copy Range("C2")
End If
.AutoFilter 1, "OLS - HGTSRT"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Intersect(.Offset(1), .Columns("h")).Copy Range("D2")
End If

ElseIf Target.Value = "WCTE" Then
.AutoFilter 1, "AL - ALWCTE"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Intersect(.Offset(1), .Columns("h")).Copy Range("b2")
End If
End If
End If

.AutoFilter

End With

wb.Close False
Application.EnableEvents = True

End Sub

spittingfire
10-09-2016, 07:26 AM
Thanks mana for your help - most appreciated. Code works well!!