Ayuda con Macro, armado de cuadro

Necesito que me ayuden a armar una macro que sirva para hacer un cuadro

Sub Macro1()
'
Dim Tabla As Recordset
Dim Base As Database
Dim SQl As String
Dim N1 As Integer, Zona As String, N2 As Integer, Colu As String, Colu_ As Integer, Nom As String
Dim N3 As Integer, Celda As String, Elev As String
Dim N4 As Integer, Oper As Integer
Dim N5 As Integer
Dim N6 As Integer
Dim N7 As Integer
Dim GteRegE, GteRegO, GteRegN, GteRegC, GteRegR, GteRegCC, GteRegER
Dim AdmRegE, AdmRegO, AdmRegN, AdmRegC, AdmRegR, AdmRegCC, AdmRegER
Dim IngPtaE, IngPtaO, IngPtaN, IngPtaC, IngPtaR, IngPtaCC, IngPtaER
Dim RegInsE, RegInsO, RegInsN, RegInsC, RegInsR, RegInsCC, RegInsER
'On Error GoTo ErrorHandler
Set Base = OpenDatabase("C:\PSS_CGestion\Personal\3_Personal.mdb")
SQl = "select * from Pruebass"
Set Tabla = Base.OpenRecordset(SQl)
Do Until Tabla.EOF
Select Case Tabla("Puesto").Value
Case Is = "Jefe Pta. Reg."
Select Case Tabla("Región").Value
Case Is = "Este"
IngPtaE = IngPtaE & "-" & Tabla("Apellido y Nombre")
Case Is = "Oeste"
IngPtaO = IngPtaO & "-" & Tabla("Apellido y Nombre")
Case Is = "Norte"
IngPtaN = IngPtaN & "-" & Tabla("Apellido y Nombre")
Case Is = "Centro"
IngPtaC = IngPtaC & "-" & Tabla("Apellido y Nombre")
Case Is = "Rosafe"
IngPtaR = IngPtaR & "-" & Tabla("Apellido y Nombre")
Case Is = "Pampa Norte"
IngPtaCC = IngPtaCC & "-" & Tabla("Apellido y Nombre")
Case Else
IngPtaER = "None"
End Select
Case Is = "Adm. Reg."
Select Case Tabla("Región").Value
Case Is = "Este"
AdmRegE = AdmRegE & "-" & Tabla("Apellido y Nombre")
Case Is = "Oeste"
AdmRegO = AdmRegO & "-" & Tabla("Apellido y Nombre")
Case Is = "Norte"
AdmRegN = AdmRegN & "-" & Tabla("Apellido y Nombre")
Case Is = "Centro"
AdmRegC = AdmRegC & "-" & Tabla("Apellido y Nombre")
Case Is = "Rosafe"
AdmRegR = AdmRegR & "-" & Tabla("Apellido y Nombre")
Case Is = "Pampa Norte"
AdmRegCC = AdmRegCC & "-" & Tabla("Apellido y Nombre")
Case Else
AdmRegER = AdmRegER & "-" & "None"
End Select
Case Is = "Gte. Reg."
Select Case Tabla("Región").Value
Case Is = "Oeste"
GteRegO = GteRegO & "-" & Tabla("Apellido y Nombre")
Case Is = "Este"
GteRegE = GteRegE & "-" & Tabla("Apellido y Nombre")
Case Is = "Norte"
GteRegN = GteRegN & "-" & Tabla("Apellido y Nombre")
Case Is = "Centro"
GteRegC = GteRegC & "-" & Tabla("Apellido y Nombre")
Case Is = "Rosafe"
GteRegR = GteRegR & "-" & Tabla("Apellido y Nombre")
Case Is = "Pampa Norte"
GteRegCC = GteRegCC & "-" & Tabla("Apellido y Nombre")
Case Else
GteRegER = GteRegER & "-" & "None"
End Select
Case Is = "Agron. Reg."
Select Case Tabla("Región").Value
Case Is = "Este"
RegInsE = RegInsE & "-" & Tabla("Apellido y Nombre")
Case Is = "Oeste"
RegInsO = RegInsO & "-" & Tabla("Apellido y Nombre")
Case Is = "Norte"
RegInsN = RegInsN & "-" & Tabla("Apellido y Nombre")
Case Is = "Centro"
RegInsC = RegInsC & "-" & Tabla("Apellido y Nombre")
Case Is = "Rosafe"
RegInsR = RegInsR & "-" & Tabla("Apellido y Nombre")
Case Is = "Pampa Norte"
RegInsCC = RegInsCC & "-" & Tabla("Apellido y Nombre")
Case Else
RegInsER = RegInsER & "-" & "None"
End Select
End Select
Tabla.MoveNext
Loop
'Borro todo en CUADRO
Sheets("Cuadro").Select
Cells.Select
Selection.ClearContents
Selection.Delete Shift:=xlUp
N1 = 1: N2 = 3: N3 = 3: N4 = 3: N5 = 3: N6 = 3: N7 = 3
Colu_ = 0
Zona = ""
Celda = "1"
Do While Celda <> ""
N1 = N1 + 1
'Cambio de Zona
Sheets("Datos1").Select
Celda = Range("A" & N1)
If Celda = "" Then Exit Do
If Celda <> Zona Then
Colu_ = Colu_ + 1
Colu = Choose(Colu_, "A", "H", "N", "T", "Z", "AF", "AL", "AR")
Zona = Celda
Sheets("Cuadro").Select
N2 = 2
Range(Colu & N2) = "Región " & Zona
Range(Colu & (N2 + 1)) = "Elevador"
Colu = Choose(Colu_, "B", "I", "O", "U", "AA", "AG", "AM", "AS")
If Colu = "AR" Then
Range(Colu & (N2 + 1)) = "Analistas"
Else
Range(Colu & (N2 + 1)) = "Administrativos"
End If
Colu = Choose(Colu_, "C", "J", "P", "V", "AB", "AH", "AN", "AT")
Range(Colu & (N2 + 1)) = "Comerciales"
Colu = Choose(Colu_, "D", "K", "Q", "W", "AC", "AI", "AO", "AU")
Range(Colu & (N2 + 1)) = "Ingenieros"
Colu = Choose(Colu_, "E", "L", "R", "X", "AD", "AJ", "AP", "AV")
Range(Colu & (N2 + 1)) = "Planta"
N3 = 3: N4 = 3: N5 = 3: N6 = 3: N7 = 3
Sheets("Datos1").Select
End If
Select Case Range("D" & N1)
Case Is = "Adm Ref", "Administrativo", "Balancero", "Analista Adm.", "Analista Cont.", "Proyecto Boero A", "Sup. Contable", "Trainee"
'Copio y pego el elevador
If Elev <> Range("B" & N1) Then
Elev = Range("B" & N1)
Sheets("Cuadro").Select
Colu = Choose(Colu_, "A", "H", "N", "T", "Z", "AF", "AL", "AR")
N4 = N4 + 1
'Range(Colu & N4) = Elev
'Parte donde agregamos satelites de acuerdo a la query de hoja Satelites
j = 0
For i = 2 To 100
Sheets("Satelites").Select
Range(Cells(i, 2), Cells(i, 2)).Select
If Elev = Range(Cells(i, 2), Cells(i, 2)) Then
Sat = Range(Cells(i, 3), Cells(i, 3))
'ahora lo pego en la hoja cuadro
Sheets("Cuadro").Select
Range(Colu & N4 + j) = Sat
j = j + 1
Else
End If
Next i
N3 = N4: N5 = N4: N6 = N4: N7 = N4
Oper = 0
Sheets("Datos1").Select
End If
'Copio y pego el nombre
Nom = Range("E" & N1)
Select Case Range("D" & N1)
Case Is = "Adm...