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
Bookmarks