VBA exportar consulta para excel células específicas

Bom dia,


Pela primeira vez, estou a tentar exportar um conjunto de dados de uma consulta, para um ficheiro de excel modelo.

Nunca tinha tentado e por isso nem sei se é possível de concretizar.

Já consegui exportar os dados de uma tabela para as células do excel, mas este caso é diferente.

Os dados exportados precisam ficar em células específicas.

Será viável de concretizar??

Envio em anexo imagem.


Obrigado
Jorge

Já adiantei alguma coisa, mas não está fácil entender o funcionamento das sintaxes do vba para excel

Mas já consigo exportar para uma folha as pessoas de um determinado grupo, como podem ver pela imagem

Mas agora tenho um problema maior.

Gostaria de exportar para cada folha de excel o grupo com as suas pessoas (envio em anexo código)

Existe um modelo de Excel já com as folhas numeradas

Ao correr o programa tinha de procurar a folha respetiva e exportar para lá as pessoas desse grupo

Já vi um código do colega JPaulo, mas está difícil de perceber como trabalhar com o sheet

Código:


Private Sub Comando51_Click()
    On Error GoTo ErrorHandling

    Dim xlApp As New Excel.Application
    Dim xlWrkBk As Excel.Workbook
    Dim xlSht As Excel.Worksheet
    
    Dim db As Database
    Dim rs As DAO.Recordset
    Dim rsProf As DAO.Recordset

    
    Dim strFilelocation As String
    Dim strFilepath As String
    
    Dim CheckFileExists As Boolean
    Dim myValue As Object
    
    Dim sSql As String
    Dim strSQL As String
    Dim strSQLProf As String
    Dim strSQLServico As String
    
    Dim linha_Prof As Integer
    Dim linha_grupo As Integer
    
    Dim coluna_servico As Integer
    Dim coluna_prof As Integer
    
    Dim codigoGrupo As Integer
    Dim codigoProf As Integer
    Dim xlrow As Integer
        
    
    
      strFilepath = [Application].[CurrentProject].[Path] & "\Exemplo2.xlsx"
        
    ' Verifica se o ficheiro existe
        CheckFileExists = Dir(strFilepath) <> vbNulString
        If CheckFileExists Then
             MsgBox "Ficheiro existe e vai ser apagado."
            'Kill strFilepath
        Else
           'ficheiro não existe
        End If
    
    'Referência para Excel app
    Set xlApp = CreateObject("Excel.Application")
    'Abre referência para ficheiro
    Set xlWrkBk = xlApp.Workbooks.Open(strFilepath)

    'referência para 1 Sheet
    Set xlSht = xlWrkBk.Sheets(1)
    
    'Abre o recordset
    Set db = CurrentDb
    
    strSQL = "SELECT Cod_Grupo FROM Grupos;"
    Set rs = db.OpenRecordset(strSQL)

    If Not (rs.BOF And rs.EOF) Then
        rs.MoveFirst
        xlrow = 1          '1ª linha para inserir valor
        Do Until rs.EOF
          'Escreve o código do grupo
          xlSht.Cells(xlrow, 1) = rs.Fields!Cod_Grupo
          
          codigoGrupo = rs.Fields!Cod_Grupo
                  
          strSQLProf = "SELECT Code_Teacher, Name_Teacher FROM Teachers WHERE Code_Group = " & codigoGrupo
          Set rsProf = db.OpenRecordset(strSQLProf)
          
          If Not (rsProf.BOF And rsProf.EOF) Then
            rsProf.MoveFirst
            linha_Prof = 4
            
            Do Until rsProf.EOF
                'colocar o nome do professor
                xlSht.Cells(linha_Prof, 2) = rsProf.Fields!Name_Teacher
        
                rsProf.MoveNext
            Loop
          End If
          rs.MoveNext
        Loop
    End If

    MsgBox "Exportação terminada!", vbInformation
    
    Set rs = Nothing
    Set rsProf = Nothing
    
    Set db = Nothing
    xlWrkBk.SaveAs strFilepath
    xlWrkBk.Close
    Set xlWrkBk = Nothing
    Set xlApp = Nothing
Exit Sub

ErrorHandling:
    MsgBox Err.Description, vbCritical, "Erro " & Err.Number
    Exit Sub
End Sub