Új hozzászólás Aktív témák

• #23364 m.zmrzlina senior tag slashing #23360

  Új Válasz 2014-09-21 08:12:59 #23364

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  m.zmrzlina

  senior tag

  válasz slashing #23360 üzenetére

  Nekem ezt sikerült kiötleni:

  Sub makro_1()
  
  elsouzenet = InputBox("blablabla1")
  masodikuzenet = InputBox("blablabla2")
  datum = InputBox("datum")
  
  Range("D5").Select
  Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
  
  Selection.Copy
  Sheets.Add
  ActiveSheet.Paste
  
  hanysor = Selection.Rows.Count
  hanyoszlop = Selection.Columns.Count
  
  For i = hanyoszlop To 1 Step -1
  Range(Cells(1, i), Cells(hanysor, i)).Select
  Selection.Insert Shift:=xlToRight
  Selection.Value = elsouzenet
  Next
  
  Range("A:B").Select
  Selection.Insert Shift:=xlToRight
  
  Range("B1").Value = masodikuzenet
  Range("A1").Value = datum
  
  Range(Cells(1, 1), Cells(hanysor, ActiveCell.End(xlToRight).Column)).Select
  Selection.Copy
  
  End Sub

• #23363 slashing senior tag slashing #23360

  Új Válasz 2014-09-21 07:49:20 #23363

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  slashing

  senior tag

  válasz slashing #23360 üzenetére

  Hát eddig jutottam:

  Sub Makró5()
  Dim c As Long, myvalue As Variant, lastrow As Long
  
  Range("D5").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Copy
  Sheets("Munka1").Select
  Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
  c = Range("XFD1").End(xlToLeft).Column
  For c = c To 2 Step -1
  Cells(1, c).EntireColumn.Insert
  Next c
  
  myvalue = InputBox("add meg a szöveget")
  Range("B1").Value = myvalue
  
  lastrow = Worksheets("munka1").Range("A1").End(xlDown).Row
  With Worksheets("munka1").Range("B1")
  .AutoFill Destination:=Range("B1:B" & lastrow&)
  End With
  
  Columns("A:B").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  
  Range("A1").Select
  myvalue = InputBox("add meg a dátumot")
  Range("A1").Value = myvalue
  
  Range("B1").Select
  myvalue = InputBox("add meg a szöveget")
  Range("B1").Value = myvalue
  
  End Sub

  közel sem tökéletes pl. a dátum helyére bármit beírhatnék de ez legyen a legkevesebb. Annyi kéne még hogy az első szöveg bekérés után kitölti az oszlopot a megadott szöveggel de ezt tovább kéne vinni az utolsó oszlopig is.

  (#23362) Delila_1

  Máris nézem köszönöm

• #23362 Delila_1 veterán slashing #23360

  Új Válasz 2014-09-21 07:45:44 #23362

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz slashing #23360 üzenetére

  A végét írd meg, most el kell rohannom.

  Sub valami()
  Dim usor As Long, uoszlop As Integer, oszlop As Integer, v$
  
  Sheets("Munka1").Select
  Range("D5").CurrentRegion.Copy Sheets("Másik lap").Range("A1")
  Sheets("Másik lap").Select
  usor = ActiveSheet.UsedRange.Rows.Count
  
  oszlop = 1
  Do
  Columns(oszlop).EntireColumn.Insert
  oszlop = oszlop + 2
  Loop While Cells(1, oszlop + 1) <> ""
  Columns(oszlop).EntireColumn.Insert
  
  v$ = InputBox("add meg az értéket")
  uoszlop = oszlop
  For oszlop = 1 To uoszlop Step 2
  Range(Cells(1, oszlop), Cells(usor, oszlop)) = v$
  Next
  End Sub

Új hozzászólás Aktív témák