Como puedo condicionar la hoja de acuerdo al valor de una celda
Tengo esta macro pero me gustaría que me ayuden a que la misma elija la hoja según el valor de una celda, gracias
Sub Macro2()
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
'
strTitulo = "Transferencia Entre Bodegas"
'
Continuar = MsgBox("Realizar Transferencia?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("JAB").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("JAB")
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("F23")
.Cells(NewRow, 4).Value = Date
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets(1).Range("L3")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(1).Range("E23")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(1).Range("N16")
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets(1).Range("L18")
End With
'
MsgBox "Transferencia Exitosa.", vbInformation, strTitulo
End Sub
1 Respuesta
H o l a:
Te anexo la macro actualizada. Cambia en esta línea el nombre de la hoja y la celda donde vas a poner el nombre de la hoja destino.
hoja = Sheets("hoja1").Range("D1")La macro:
Sub Macro2()
'
Dim strTitulo As String
Dim Continuar As String
Dim hoja As String
Dim TransRowRng As Range
Dim NewRow As Integer
'
strTitulo = "Transferencia Entre Bodegas"
hoja = Sheets("hoja1").Range("D1")
If hoja = "" Then
MsgBox "Debes indicar un nombre de hoja"
Exit Sub
End If
For Each h In Sheets
If UCase(h.Name) = UCase(hoja) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "No existe la hoja: " & hoja
Exit Sub
End If
'
Continuar = MsgBox("Realizar Transferencia?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets(hoja).Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets(hoja)
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("F23")
.Cells(NewRow, 4).Value = Date
. Cells(NewRow, 5).Value = ThisWorkbook. Sheets(1). Range("L3")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(1).Range("E23")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(1).Range("N16")
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets(1).Range("L18")
End With
'
MsgBox "Transferencia Exitosa.", vbInformation, strTitulo
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Dante Amor gracias por el aporte excelente de verdad pero una ayuda final en esta parte de la macro me copia solo la celda seleccionada y si quisiera un rango de celdas??
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("F23")
.Cells(NewRow, 4).Value = Date
. Cells(NewRow, 5).Value = ThisWorkbook. Sheets(1). Range("L3")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(1).Range("E23")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(1).Range("N16")
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets(1).Range("L18")
Lo que hace la macro es pasar un valor de una celda a otra celda.
No puedes pasar un rango de celdas a una sola celda.
Por ejemplo, lo que hace es pasar el dato de la celda F23 a la celda Bn (n es la nueva fila)
Si quieres que ajuste la macro, deberás crear una nueva pregunta y me explicas con ejemplos qué quieres pasar y en dónde lo quieres poner, todo explicado con ejemplos reales, de preferencia con imágenes.
En el desarrollo de la nueva pregunta escribe "para Dante Amor"
Sal u dos
para dante amor
tengo esta guía de salida y quiero trasladar los items ingresados a una base de datos de transferencia
aqui estan los items ingresados y lo que deseo es que se pase todos con los mismos datos
esta es la base de datos donde debe de poner todos los items en los campos de "descripcion" y "salida" y los campos de "fecha","guia","unidad","chofer" se copien igual x la cantidad de items ingresados
ya que la macro actual solo pasa la primera fila.
gracias
Tienes que crear una pregunta nueva en todoexpdertos dentro del tema de excel.
