以下のコードでアクセスからデータをエクスポート後に
複数（50くらい）シート名を変更し、シートを並び替えし、
列幅を整えています。
次にデータをソートしたいのですが、うまく範囲指定が
できないで２日くらいすぎてしまいました。
以下の**でかこった部分で定義ができません。
どなたかお助けしていただけないでしょうか？
よろしくお願いします。
うまく改行できないですいません・・。
****************************************************
h = 1
o = 29
ws.Columns(h & ":" & o).Select
範囲指定したいのはA列からAC列までのデータの入った
行数までです。
With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP))
****************************************************
Private Sub CommandButton1_Click()
Dim path$, wb As Workbook, wbName$
Dim ws As Worksheet, i&
Dim intLoopA As Integer
Dim intLoopB As Integer
Dim h As Long
Dim o As Long
path = ThisWorkbook.path & "\"
wbName = Dir(path & "*.xls")
Do Until wbName = ""
If wbName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(path & wbName)
i = 2
For Each ws In wb.Worksheets
If Trim(ws.Range("A2")) <> "" Then
On Error Resume Next
ws.Name = ws.Range("A2")
If Err.Number <> 0 Then
ws.Name = ws.Range("A2") & " (" & i & ")"
i = i + 1
End If
On Error GoTo 0
End If
For intLoopA = 1 To Sheets.Count
For intLoopB = 1 To Sheets.Count - 1
If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then
Sheets(intLoopB).Move after:=Sheets(intLoopB + 1)
End If
Next intLoopB
Next intLoopA
With ws.Rows(1)
With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToLeft))
.Interior.ColorIndex = 15
.EntireColumn.AutoFit
End With
End With
h = 1
o = 29
ws.Columns(h & ":" & o).Select
With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP))
.Sort _
Key1:=Range("G1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
End With
End With
DoEvents
Next
wb.Save
End If
wbName = Dir
Loop
Set wb = Nothing
Set ws = Nothing
MsgBox "処理が完了しました。", vbInformation, "処理確認"
End Sub
以下のコードでアクセスからデータをエクスポート後に
複数（50くらい）シート名を変更し、シートを並び替えし、
列幅を整えています。
次にデータをソートしたいのですが、うまく範囲指定が
できないで２日くらいすぎてしまいました。
以下の**でかこった部分で定義ができません。
どなたかお助けしていただけないでしょうか？
よろしくお願いします。
うまく改行できないですいません・・。
****************************************************
h = 1
o = 29
ws.Columns(h & ":" & o).Select
範囲指定したいのはA列からAC列までのデータの入った
行数までです。
With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP))
****************************************************
Private Sub CommandButton1_Click()
Dim path$, wb As Workbook, wbName$
Dim ws As Worksheet, i&
Dim intLoopA As Integer
Dim intLoopB As Integer
Dim h As Long
Dim o As Long
path = ThisWorkbook.path & "\"
wbName = Dir(path & "*.xls")
Do Until wbName = ""
If wbName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(path & wbName)
i = 2
For Each ws In wb.Worksheets
If Trim(ws.Range("A2")) <> "" Then
On Error Resume Next
ws.Name = ws.Range("A2")
If Err.Number <> 0 Then
ws.Name = ws.Range("A2") & " (" & i & ")"
i = i + 1
End If
On Error GoTo 0
End If
For intLoopA = 1 To Sheets.Count
For intLoopB = 1 To Sheets.Count - 1
If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then
Sheets(intLoopB).Move after:=Sheets(intLoopB + 1)
End If
Next intLoopB
Next intLoopA
With ws.Rows(1)
With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToLeft))
.Interior.ColorIndex = 15
.EntireColumn.AutoFit
End With
End With
h = 1
o = 29
ws.Columns(h & ":" & o).Select
With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP))
.Sort _
Key1:=Range("G1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
End With
End With
DoEvents
Next
wb.Save
End If
wbName = Dir
Loop
Set wb = Nothing
Set ws = Nothing
MsgBox "処理が完了しました。", vbInformation, "処理確認"
End Sub
