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

呆呆休

谢谢

曹雪峰

看看

别别别

看看

枫华

不知道答案，来看一看

xiongweixiang

'合并工作表
Sub t9()
Dim str As String, x As Integer

str = ThisWorkbook.Path
If Dir(str & "\A.xls") = "" Then      '以下到100 是判断文件是否存在，如果存在 看是否打开，如果没打开则打开
   MsgBox "文件不存在"
   Exit Sub
Else
     For x = 1 To Windows.Count
       If Windows(x).Caption = "A.xls" Then GoTo 100
       Next x
           Workbooks.Open (str & "\A.xls")
End If
100:
Dim i As Integer, MaxRow1 As Integer, MaxRow2 As Integer, newSh As Worksheet, sht As Worksheet
'判断是否存在合并工作表
For Each sht In ThisWorkbook.Worksheets
     If sht.Name = "合并工作表" Then
     MsgBox "该工作表已经存在"
     GoTo 110
     End If
Next
Set newSh = ThisWorkbook.Sheets.Add
newSh.Name = "合并工作表"
Workbooks("A.xls").Sheets(1).Rows(1).Copy newSh.Range("a1") '增加一个表头

110:
For i = 1 To Application.Workbooks("A.xls").Sheets.Count
    MaxRow2 = ThisWorkbook.Sheets("合并工作表").Range("A1").CurrentRegion.Rows.Count
    MaxRow1 = Workbooks("A.xls").Sheets(i).Range("A1").CurrentRegion.Rows.Count

            Workbooks("A.xls").Sheets(i).Rows("2:" & MaxRow1).Copy ThisWorkbook.Worksheets("合并工作表").Range("a" & MaxRow2 + 1)

Next i
End Sub

vikings0316

学习学习

这个女人叫小美

Sub 第一题()
Dim rg As Range
Set rg = Range("B:D").SpecialCells(xlCellTypeConstants).EntireRow
Intersect(Columns(1), rg) = 1
End Sub
Sub 第二题()
Dim i
Dim w As Workbook, w1 As Worksheet
Set w1 = ThisWorkbook.Sheets(2)
Set w = Workbooks.Open(ThisWorkbook.Path & "\A.xls")
w.Sheets(1).UsedRange.Copy w1.Range("a1")
For i = 2 To w.Sheets.Count
    w.Sheets(i).UsedRange.Offset(1, 0).Copy w1.Range("a65536").End(xlUp).Offset(1, 0)
Next i
w.Close 0
End Sub

asdf19880718

学习下

noob1015

学习学习

xjnvq

考古