Excel VBA 文字列のセルを反映させたいです

大変お世話になっております。
以下のVBAを実行すると、セルの書式設定で『文字列』のセル（例えば、052等、数字の頭が0のため文字列にしたセル）が反映されません…。
（複数のシートを1つのシートにまとめるVBAでして、まとめる前の元のシートに文字列が含まれています）
文字列を反映したいため、コードの修正をしていただけると有難い限りです…。
お手数ですが、コードの全文をご記載いただけると本当に助かります…。

Sub 複数のシートを1つのシートにまとめる()

Dim i As Long
Dim r As Long
Dim s As Long
Dim Sh As Worksheet
Dim MaxRow As Long
Dim MaxCol As Long
Dim MyArray As Variant
Dim JoinSh As Worksheet

Application.DisplayAlerts = False 'シート削除時のアラート停止

For Each Sh In Worksheets

If InStr(Sh.Name, "統合") <> 0 Then Sh.Delete 'すでに統合シートが存在する場合は一旦削除

Next

Application.DisplayAlerts = True 'シート削除時のアラート停止を解除

s = 1 '最大行を超えた場合次の統合シートを作成するための番号

Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加
ActiveSheet.Name = "統合"

Set JoinSh = ActiveSheet '統合シートを変数に格納

For i = s + 1 To Worksheets.Count 'シートを統合シートの次～末尾までループ

With Worksheets(i) '各月シート

If i = 2 Then

r = 1 '最初だけ項目も取得

Else

r = 2 '最初以外は2行目から取得

End If

MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得
MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得

MyArray = Range(.Cells(r, 1), .Cells(MaxRow, MaxCol)) 'A1～データ末尾まで配列に格納

End With

With JoinSh '統合シート

MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの１列目で最終行取得

If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理

s = s + 1 '統合シートの番号を加算

Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加
ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加

Set JoinSh = ActiveSheet '統合シートを変数に格納
MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの１列目で最終行取得

End If

If .Cells(1, 1) = "" Then
'最初だけ1行目から貼り付け
Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray

Else
'最初以外は最終行の次に貼り付け
Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray

End If

End With

Next i

End Sub

ご回答を心よりお待ちしております。
大変恐縮ですが、どうぞ宜しくお願い申し上げます。

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/02/24 09:27

以下のようにしてください。

但し、最大行（Rows.count）を超えた場合の対応はしていません。
当方の環境(excel2019)では、Rows.count＝1,048,576なので約１００万行になります。最大行を超えることはないと考えています。
あなたの環境が非常に古いexcelの場合は問題があるかもしれません。

Sub 複数のシートを1つのシートにまとめる()

Dim i As Long
Dim r As Long
Dim s As Long
Dim Sh As Worksheet
Dim MaxRow As Long
Dim MaxCol As Long
Dim JoinSh As Worksheet
Dim NextRowJ As Long

Application.DisplayAlerts = False 'シート削除時のアラート停止

For Each Sh In Worksheets

If InStr(Sh.Name, "統合") <> 0 Then Sh.Delete 'すでに統合シートが存在する場合は一旦削除

Next

Application.DisplayAlerts = True 'シート削除時のアラート停止を解除

s = 1 '最大行を超えた場合次の統合シートを作成するための番号

Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加
ActiveSheet.Name = "統合"

Set JoinSh = ActiveSheet '統合シートを変数に格納

For i = s + 1 To Worksheets.Count 'シートを統合シートの次～末尾までループ

With Worksheets(i) '各月シート

If i = 2 Then

r = 1 '最初だけ項目も取得
NextRowJ = 1
Else

r = 2 '最初以外は2行目から取得
NextRowJ = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row + 1

End If

MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得
MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得

.Range(.Cells(r, 1), .Cells(MaxRow, MaxCol)).Copy Destination:=JoinSh.Range("A" & NextRowJ)

End With


Next i

End Sub

この回答へのお礼

tatsumaru77 様!
お忙しい中、ご回答をしていただきまして本当に有難うございました…!

問題のあった文字列のセルが、見事に反映されました…!
心より感謝申し上げます…!

他にも検討が必要なコードがあるため、また質問をさせていただくと思います…。
その際にもどうか宜しくお願い申し上げます…!

この度は助けていただきまして、本当に有難うございました!
深く感謝申し上げます…!
大変恐縮ですが、次回以降もどうぞ宜しくお願い申し上げます…!!

お礼日時：2024/02/25 00:12

No.1 回答者： 銀鱗 回答日時： 2024/02/24 00:33

残念ですが、ここは作業依頼をする場所ではありません。

自力で解決するためのアドバイスを貰う場所です。
(´・ω・`) ごめんね。

作業依頼をするのであれば、有料サイトでお金を払って作業委託するようにしましょう。


・・・解決に至る回答を貰える質問をするためのアドバイス・・・

そんなわけですので、そのコードの何が分からないのかを具体的に質問すると、理解に役立つアドバイスを貰えると思います。
　例：「文字列を切り出しているところがどこなのか分からないので教えてください」