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

• #22194 Delila_1 veterán slashing #22192

  Új Válasz 2014-06-29 15:04:11 #22194

  Ú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 #22192 üzenetére

  A DoWork makró End With fölötti sora legyen

  Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True

  Szerk.:

  Inkább leírom a 2. makrót is.

  Sub DoWork(wb As Workbook, WBN, WS)
  Dim usor As Long, cell As Range, selectRange As Range
  With wb
  usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
  For Each cell In .Sheets(1).Range("A3:A" & usor)
  If (cell.Value <> "") Then
  If selectRange Is Nothing Then
  Set selectRange = cell
  Else
  Set selectRange = Union(cell, selectRange)
  End If
  End If
  Next cell
  
  usor = Workbooks(WBN).Sheets(WS).Range("A" & Rows.Count).End(xlUp).Row + 1
  selectRange.Copy
  Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
  End With
  End Sub

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