Kopiera från rad till sista raden med data till ett ark med VBA i Microsoft Excel

Anonim
  • Makrot lägger till ett blad med namnet Master i din arbetsbok och kopierar cellerna från varje blad i din arbetsbok i det här kalkylbladet.
  • Det första makrot gör en normal kopia och det andra makrot kopierar värdena.
  • Makrons subs använder funktionerna nedan, makron fungerar inte utan funktionerna.
Sub CopyFromRow () Dim sh As Worksheet Dim DestSh As Worksheet Dim shLast As Long Dim Last As Long If SheetExists ("Master") = True Then MsgBox "Sheet Master exist exist" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" för varje sh i ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Then Last = LastRow (DestSh) shLast = LastRow (sh) sh.Range ( sh.Rows (3), sh.Rows (shLast)). Copy DestSh.Cells (Last + 1, 1) End If End If Next Application.ScreenUpdating = True End Sub Sub CopyFromRowValues ​​() Dim sh As Worksheet Dim DestSh As Worksheet Dim shLast As Long Dim Last As Long If SheetExists ("Master") = True Då MsgBox "Sheet Master finns redan" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" För varje sh I ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Then Last = LastRow (DestSh) shLast = LastRow (sh) With sh.Range (sh.Rows (3), sh.Rows (shLast)) DestSh.Cells (Last + 1, 1) .Resize (.Rows.Count, _ .Columns.Count) .Value = .Value End With End If End If Next If Next Application.ScreenUpdating = True End Sub Funktion LastRow (sh Som arbetsblad) Vid fel Återuppta Nästa LastRow = sh.Cells.Find (Vad: = "*", _ Efter: = sh.Range ("A1"), _ Lookat: = xlPart, _ LookIn: = xlFormulas , _ SearchOrder: = xlByRows, _ SearchDirection: = xlPrevious, _ MatchCase: = False) .Row On Error GoTo 0 Avsluta funktion Funktion Lastcol (sh Som arbetsblad) Vid fel Återuppta nästa Lastcol = sh.Cells.Find (What: = " *", _ After: = sh.Range (" A1 "), _ Lookat: = xlPart, _ LookIn: = xlFormulas, _ SearchOrder: = xlByColumns, _ SearchDirection: = xlPrevious, _ MatchCase: = False) .Column On Error GoTo 0 Avsluta funktion Funktion SheetExists (SName As String, _ Valfritt ByVal WB som arbetsbok) Som Boolean på fel Återuppta nästa om WB inte är något, ställ sedan in WB = ThisWorkbook SheetExists = CBool ​​(Len (Sheets (SName) .Name))