First, i want to say that i have 0 knowledge on vba or progamming, i just used my common sense and few pieces of other people's codes, this is probably why my code is not working properly
I created a code that searches for a specific information in a workbook and paste it on another workbook, pasting the copied information in the sheet with the same name as the information source.
I Need to update my final sheet (Erros.xmlm) at least once a week, because i need to keep my workbook updated. But if i use the macro again it duplicate all the information that i already had copied.
My question is: Can I create a way so excel knows if it already copied that information and dont do it again.
If it isnt possible can I limit the range that it will paste the information, so instead of pasting new info it will ovewrite the old ones.
Here is my code
Function IsWorkBookOpen(FileName As String)
Dim FF As Integer, ErrNum As Integer
Select Case ErrNum
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNum
End Select
End Function
Sub Importar()
Dim Font As Workbook
Dim Dest As Workbook
Dim pesq As Range
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim ini As Range
Dim info
info = IsWorkBookOpen("C:\Users\EU\Desktop\Projetos\Arquivos fonte\Resumo de Entrega Mensal - comparativo.xlsx")
If info = False Then
Workbooks.Open ("C:\Users\EU\Desktop\Projetos\Arquivos fonte\Resumo de Entrega Mensal - comparativo.xlsx")
End If
Set Font = Workbooks("Resumo de Entrega Mensal - comparativo.xlsx")
Set Dest = Workbooks("erros.xlsm")
For x = 1 To Font.Sheets.Count
For Z = 1 To Dest.Sheets.Count
If Right(Font.Worksheets(x).Name, 5) = Right(Dest.Worksheets(Z).Name, 5) Then
Set copySheet = Font.Worksheets(x)
Set pasteSheet = Dest.Worksheets(Z)
On Error Resume Next
Font.Worksheets(x).Activate
Set pesq = copySheet.Range("A1").Resize(500, 10).Find(What:="Semana", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set ini = pasteSheet.Range("A1")
If Not pesq Is Nothing Then
firstAddress = pesq.Address
Do
pesq.Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(14, 0)).Select
Selection.Copy
ini.PasteSpecial
Application.CutCopyMode = False
Set pesq = copySheet.Range("A1").Resize(500, 10).FindNext(pesq)
Set ini = pasteSheet.Range("IV1").End(xlToLeft).Offset(, 2)
Loop While Not pesq Is Nothing And pesq.Address <> firstAddress
End If
End If
Next Z
Next x
Font.Close
End Sub
Display More
and some sample of my workbooks if you want to try it