Como distribuir valores

Question

bom dia. 

gostaria de criar um código em VBA para fazer o seguinte:

eu tenho uma lista de digamos 5 mil nomes, endereços e vários outros dados. Eu gostaria de distribuir isso para 40 pessoas diferentes. ou seja, pegar os 5 mil e automaticamente distribuir para cada qual com o seu nome. Exemplo do contato 1 - 125 ficaria na coluna determinada o nome do fulano, do 126 - 250 o nome do ciclano, assim por diante até completarem os 5 mil contatos. a pior parte é conseguir distribuir isso em 6 dias de trabalho por semana. Tipo, os contatos do mês para cada dia que será trabalho no mês. Eu estou perdido e não sei como fazer. preciso de ajuda.

Answer 1

 Ola Thiago, boa noite.

Primeiramente crie uma copia de sua planilha.

Crie um Form com um TextBox e um CommandButton.

No CommandButton insira o código:

Private Sub CommandButton1_Click()
If TextBox1 = "" Then
MsgBox "Por favor, digite um nome!", vbCritical, "Alerta!"
Else
ThisWorkbook.Worksheets("Plan1").Activate
Range("a1:d125").Select
Excel.Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Users\SeuNomeDeUsuário\Desktop\" & TextBox1.Value & ".txt", FileFormat:=xlCSV
ActiveSheet.Name = "Plan1"
Excel.Application.DisplayAlerts = True
Selection.Delete Shift:=xlUp
MsgBox "Arquivo criado com sucesso!", vbOKOnly, "Confirmação!"
TextBox1 = ""
TextBox1.SetFocus
End If
End Sub

Ao clicar no CommandButton, será criado um arquivo de texto no Desktop com o nome digitado no TextBox, contendo os dados das colunas A até D, nas linhas 1 até 125.

Answer 2

Suponha que os 5 mil nomes estejam no intervalo A1:A5000 da planilha ativa. Use este código:

Sub Exemplo()
    Dim wsThis As Worksheet
    Dim wsNew As Worksheet
    Dim lCol As Long
    
    Set wsThis = ActiveSheet
    Set wsNew = Workbooks.Add(xlWBATWorksheet).Sheets(1)
    
    For lCol = 0 To 39
        wsThis.Cells(125 * lCol + 1, "A").Resize(125).Copy Destination:=wsNew.Cells(2, lCol + 1)
    Next lCol
    
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br