VBA80集第12集作业上交贴：非空行

111

tz2302200 发表于 2019-4-15 12:35

Sub 可爱的小焱焱()
Dim wb As Workbook, i%
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "A.xls")
For i = 2 To wb.Sheets.Count
  ActiveWorkbook.Sheets(i).Range("a2", [d2].End(xlDown)).Copy Sheets(1).[A1].End(xlDown)(2, 1)
Next
ActiveWorkbook.Sheets(1).UsedRange.Copy
    Windows("第12集练习题.xls").Activate
    Range("A1").Select
    ActiveSheet.Paste
End Sub

6

12.

cranezb

goooood

jiahe0

学习学习

qingboss

Sub q()
Dim wb, wb1 As Workbook
Dim sht As Worksheet
Dim i, j, k, m As Integer
Dim rng, rng1 As Range

Set wb1 = ThisWorkbook
Workbooks.Open ThisWorkbook.Path & "\A.xls"
Set wb = ActiveWorkbook

For Each sht In wb.Sheets

    Set rng = wb1.Sheets(2).Range("a10000").End(xlUp).Offset(1, 0)
   
    Set rng1 = sht.UsedRange

    i = rng1(rng1.Count).Row
   
    j = rng1(rng1.Count).Column
   
    k = sht.Cells(i, j).CurrentRegion.Row
   
    m = sht.Cells(i, j).CurrentRegion.Column

    If wb1.Sheets(2).Range("a1") = "" Then
   
        wb1.Sheets(2).Cells.Clear

        sht.Cells(i, j).CurrentRegion.Copy wb1.Sheets(2).Range("a1")
   
    Else
   
        sht.Range(sht.Cells(k + 1, m), sht.Cells(i, j)).Copy rng
        
    End If
Next
wb.Close False
End Sub