So the code that I have done is working importing a specific range of values and pasting perfectly in the target folder.
But in my company there exists a need to import the data from that file but to always increment. For example: the file where I extract the data is from week 1 and the info is in the main file but next week the file from week 2 is out and needs to be imported when I import the data it pastes the data over the old one.
But the problem is that I also need to keep the old data in the main file too. So It should increment down below. to demonstrate this I will use some numbers.
Data Imported from first week source workbook: 1,1,1,1
Data pasted In target workbook: 1,1,1,1
Data Imported from second week source workbook: 2,2,2,2
Data Pasted in target workbook: 2,2,2,2
Result wanted data imported from both source WB to target WB: 1,1,1,1,2,2,2,2
Can you try adding the code in my existing code.![]()
Sub ImportData() Application.ScreenUpdating = False Dim Path As String, Lstrw As Long Dim SourceWb As Workbook Dim TargetWb As Workbook Path = "C:\Users\DZPH8SH\Desktop\Status 496 800 semana 12 2015.xls" 'Change this to your company workbook path Set SourceWb = Workbooks.Open(Path) Set TargetWb = ThisWorkbook Dim n As Integer, targetRow As Long targetRow = 3 With SourceWb.Sheets(1) Lstrw = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row .Range("M1:M" & Lstrw).AutoFilter Field:=1, Criteria1:="496" .Application.Union(.Range("D2:D" & Lstrw), .Range("F2:F" & Lstrw), .Range("I2:I" & Lstrw), .Range("M2:M" & Lstrw)).Copy TargetWb.Sheets(7).Range("A" & targetRow).PasteSpecial xlPasteValues .ShowAllData End With With SourceWb.Sheets(2) Lstrw = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row .Application.Union(.Range("D2:D" & Lstrw), .Range("F2:F" & Lstrw), .Range("I2:I" & Lstrw), .Range("M2:M" & Lstrw)).Copy TargetWb.Sheets(7).Cells(TargetWb.Sheets(7).Rows.Count,"A").End(xlUp)(2).PasteSpecial xlPasteValues End With SourceWb.Close savechanges:=False Application.ScreenUpdating = True End Sub











LinkBack URL
About LinkBacks
Register To Reply

Bookmarks