Unire dati da due fogli in unica colonna

[lone wolf]

Salve, avrei la necessità di unire i dati in colonna da due fogli diversi in unica colonna e ordinarli in ordine dalla A alla Z, il file è composto da tre fogli: Elenco Farmaci, Solo Farmaci e Materiale vario. Nei fogli Solo farmaci e materiale vario inserisco i dati in base alla loro natura e dovrei “aggiornare” i dati di entrambi i fogli nel foglio Elenco Farmaci a partire dalla cella B7. Allego un file di prova. Con la speranza del vostro aiuto auguro una buona serata a tutti

https://mega.nz/file/eXglSJiT#AstTE975e ... 2iB3_oasZ4

[Anthony47]

Ti ho modificato la prima parte della Sub NuovoFarmaco per
-controllare che una sigla sia inserita in B3
-controllare che la stessa sigla non sia gia' presente nel foglio corrente ("Solo Farmaci")
-accodare la nuova sigla sul foglio corrente
-accodare la nuova sigla in "Elenco Farmaci", se la nuova sigla non e' gia' presente
La seconda parte si occupa dell'ordinamento e praticamente non e' cambiata (salvo 1000 -> 10000)

Il nuovo codice complessivo:

Codice: Seleziona tutto

Sub NuovoFarmaco()
'    Application.ScreenUpdating = False   'Inutile
If Range("B3").Value <> "" Then
    If IsError(Application.Match(Range("B3").Value, Range("B6:B10000"), False)) Then
        Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Value = Range("B3").Value
        MsgBox (Range("B3").Value & vbCrLf & "Nuovo farmaco INSERITO")
        If IsError(Application.Match(Range("B3").Value, Sheets("Elenco Farmaci").Range("B6:B10000"), False)) Then
            Sheets("Elenco Farmaci").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Value = Range("B3").Value
        End If
    Else
        Range("B3").Select
        rispo = MsgBox("Farmaco gia' presente in elenco; inserimento Abortito", vbCritical, "ERRORE")
        Exit Sub
    End If
Else
    rispo = MsgBox("Nessun Farmaco in B3; procedura di inserimento abortita", vbExclamation, ERRORE)
    Range("B3").Select
    Exit Sub
End If
'
ActiveWorkbook.Worksheets("Solo Farmaci").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Solo Farmaci").Sort.SortFields.Add Key:=Range("B7" _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Solo Farmaci").Sort
    .SetRange Range("B7:B10000")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Range("B3").Select
Selection.ClearContents
End Sub

La macro per "Nuovo Materiale" e' praticamente identica, salvo modifica dove vedi la scritta del nome foglio; sono certo che non avrai problemi (ma se per assurdo ce ne fossero sai dove trovarci)

Ciao

[lone wolf]

Buona sera, Anthony è perfetta ho modificato il nome del foglio per adattarla al foglio Materiale vario e funziona perfettamente, grazie per la tua sempre cortese disponibilità, una buona serata a tutti e alla prossima, grazie ancora