copiare dati nuovi

Hai un problema con Excel?

Nuova discussione

copiare dati nuovi
di rup (utente non iscritto) data: 25/03/2015 18:48:42
Ciao a tutti
vorrei copiare una serie di righe (ognuna caratterizzata da valori diversi) da un file ad un altro, incolonnando le nuove righe a quelle già esistenti ma SOLO SE NON GIA' PRESENTI IN ELENCO

come si può fare?
grazie:)
di alfrimpa data: 25/03/2015 21:57:21
Ciao Rup

A lume di naso la tua richiesta non mi sembra proprio banalissima (nella realizzazione intendo).

Prova ad allegare dei file di esempio (con struttura uguale ai tuoi ma con dati fittizi) che magari facciamo qualche tentativo.

Alfredo
di rup (utente non iscritto) data: 26/03/2015 09:28:35
ok, grazie, ci provo....
In realtà ho manipolato una macro presa dal forum adattandola alle mie esigenze ma bisognerebbe aggiungere qualcosa per filtrare i record che per errore si ripresentano:

Public ApplicationFileSearch As New FileSearch
Sub REGISTRA_IN_ARCHIVIO()
Application.ScreenUpdating = False

indu = Mid([H1], 1, 10)

Dim fs As FileSearch, ws As Worksheet, i As Long, fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

Dim CartellaSelezionata As Variant

Set fs = ApplicationFileSearch
With fs
.LookIn = "C:CICLATI" 'indichiamo la cartella in cui cercare
.FileName = "*.xlsm"

If .Execute() > 0 Then

For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)

fdd = FileDateTime(x)

ff = Mid(fdd, 1, 10)

If ff < indu Or ff = indu Then GoTo 10

Dim f
Set fn = CreateObject("Scripting.FileSystemObject")
Set nome = fn.Getfile(x)
f = nome.Name

Workbooks.Open FileName:=x

ChDir "C:REGISTRATI"
ActiveWorkbook.SaveAs

Worksheets("FO").Select
Range("A185:AN185").Select
Selection.Copy

Workbooks("Archivio.xlsm").Activate

Worksheets("records").Select

[H1] = ff

Dim IRow As Integer
IRow = 2
While Cells(IRow, 1).value <> ""
IRow = IRow + 1
Wend

Cells(IRow, 1).Select
ActiveSheet.paste
Selection.PasteSpecial paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveWindow.ActivateNext
ActiveWindow.Close

10: 'indice riga
Next
End If
End With
ActiveWorkbook.Save
'ActiveWorkbook.Close 'solo se volessimo chiudere la cartella Archivio
End Sub

Vuoi Approfondire?