Vba code error - copy cells from one workbook to another

This is my code. I must copy cells that have some string in the formula from one sheet to the same position in another sheet.
For last column data in the previous year i must copy a column from the previous year, but i must add one column more, like:
if year is 2018, the last cell is [K4] then in new year i must add data for 2019 as [L4]:
[K4] = 'D:\Data\[WB_1990-2019.xlsx]1A1aii'!D155
and [L4] should be: 'D:\Data\[WB_1990-2019.xlsx]1A1aii'!E155

How to make this changes?

Sub Test3()
Dim x As String
Dim found As Boolean
Dim lcol As Long
Dim lrow As Long
Dim r As Long, c As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim sh As Worksheet
Dim shName As String
Dim SelectedCell As Range
Dim AddCell As Range
Dim r1 As Range, r2 As Range



Set wb1 = Workbooks("PreviousYear.xlsm") ' Excel worksheet with data from Previous year
Set wb2 = Workbooks("NewYear.xlsx") ' Excel workbook with data for New year

'Excel VBA for real last used column and row.
lrow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lcol = Cells.Find(What:="*", _
After:=Range("AZ4"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column


x = ".xls" ' Searchin string in Formula
For Each sh In wb1.Sheets ' For each sheet in wb1
shName = sh.Name

For c = 3 To lcol + 1
For r = 4 To lrow

' Set Boolean variable "found" to false.
found = False
wb1.ActiveSheet.Cells(r, c).Select
' Check if Cell have tihis string
If InStr(1, ActiveCell.Formula, x, vbTextCompare) > 1 Then
found = True
End If
' What if found?
If found = True Then
' Set SelectedCell = ActiveCell.Address
' Set wb2.Sheets = wb1.Sheets

MsgBox "Value found in cell " & ActiveCell.Address
Set SelectedCell = sh.Range(ActiveCell.Address)
Set AddCell = Range(ActiveCell.Address)
Set r2 = wb2.Sheets(shName).Range(AddCell)
End If
Next
Next
Next

End Sub

This will copy the found cells to the new workbook...

Please Login or Register  to view this content.

but I'm kinda lost about where to copy what column to where. Can you post a workbook with a before and after?


Please attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

Thanks.
Previous year is in PY_XLS and newYear is in NewYear
NewYear workbook have the same sheet names, but not all of sheets, because different offices are using different sheets.

Still not sure exactly what you want. That said, possibly this will do what you want. It finds the last column in the active sheet and uses it to fill in the next column...

Please Login or Register  to view this content.